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 # The local Table directory only exists when running SGC as a script
39 localTableDir$ = "Data"
43 buttonsTableName$ = "MainPage"
44 configTableName$ = "Config"
50 te.buttonPressValue = 0
51 samplingFrequency = 44100
54 # Pop-Up window colors
55 sgc2.popUp_bordercolor$ = "{0.5,0.5,1}"
56 sgc2.popUp_backgroundcolor$ = "{0.9,0.9,1}"
58 # If running in a packed script binary
59 if index_regex(preferencesDirectory$, "(?i'sgc2.demoAppName$')$")
60 preferencesAppDir$ = preferencesDirectory$
61 elsif index_regex(preferencesDirectory$, "[pP]raat(\-dir| Prefs)?$")
62 # If running as a Praat script, create a new preferences directory
64 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
66 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
69 # It has to go somewhere. Make a subdirectory in the current preferences directory
70 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
74 # Parameters for isolating recorded speech from noise
75 # Should be mostly left alone unless you are using ultra clean
76 # or very noisy recordings
82 # Set up button height
88 defaultFont$ = "Helvetica"
94 # Load supporting scripts
95 # Load tables in script format
96 include CreateTables.praat
97 include CreateWordlists.praat
98 # Set up system and load preferences
99 include InitialiseSGC2.praat
100 # Include the main page buttons and procedures
101 include MainPage.praat
102 # Include the configuration page buttons and procedures
106 # replaySGC2LogFunction$ = "replaySGC2LogFunction"
107 # procedure replaySGC2LogFunction
116 # Start instruction loop
117 while demoWaitForInput()
125 call buttonClicked 'buttons$' '.clickX' '.clickY'
126 .label$ = buttonClicked.label$
127 elsif demoKeyPressed()
128 .pressed$ = demoKey$()
129 call keyPressed 'buttons$' '.pressed$'
130 .label$ = keyPressed.label$
133 # You cannot select a text field
134 if startsWith(.label$, "$")
140 te.buttonPressValue = 0
142 call Draw_button 'buttons$' '.label$' 1
143 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
145 call Draw_button 'buttons$' '.label$' 'te.buttonPressValue'
152 ########################################################
154 # Definitions of procedures
156 ########################################################
159 procedure process_label .label$ .clickX .clickY .pressed$
160 # Prcoess the command
161 if .label$ <> "" and not startsWith(.label$,"!")
162 .label$ = replace_regex$(.label$, "^[#]", "", 0)
163 .label$ = replace$(.label$, "_", " ", 0)
166 'sgc2.logging$' call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
168 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
173 procedure init_buttons
175 call Draw_all_buttons 'buttons$'
181 procedure Draw_all_buttons .table$
182 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
183 select Table '.table$'
184 .numRows = Get number of rows
187 .label$ = Get value... '.row' Label
188 if not startsWith(.label$, "!")
190 # Determine the "pressed" state of a button
191 # A variable with the same name as the button will act as a
193 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
194 # Simple boolean variables
195 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
197 if '.variableName$' > 0
200 elsif '.variableName$' < 0
203 elsif index(.variableName$, "_") <= 0 and variableExists("'.variableName$'$")
205 if '.variableName$'$ <> "" and '.variableName$'$ <> "0"
208 # Complex buttons with an variableName+'_'+value structure
209 # varableName$ -> name of button, e.g., "language"
210 elsif index(.variableName$, "_")
211 .generalVar$ = left$(.variableName$, rindex(.variableName$, "_") - 1)
212 .currentVariableName$ = .generalVar$
214 if variableExists(.generalVar$+"$")
215 .currentVariableName$ = .generalVar$ + "$"
217 # Remove one level of indirection
218 if variableExists(.currentVariableName$)
219 if index(.currentVariableName$, "$")
220 .currentVariableName$ = '.currentVariableName$'
222 .currentValue = '.currentVariableName$'
223 .currentVariableName$ = "'.currentValue'"
225 # Remove next level of indirection
226 .currentContent$ = "'.currentVariableName$'"
227 if .currentContent$ = "_DISABLED_"
230 # Reconstruct label from current values
231 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
232 # Set PRESSED from label
233 if .variableName$ = .currentLabelValue$
238 # You did erase everything before you started here? So do not do that again
239 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
244 # Draw a button from a predefined button table
245 # Normally, erase the area around a button
246 procedure Draw_button .table$ .label$ .push
247 call Draw_button_internal 1 '.table$' '.label$' '.push'
250 # Use this function if you want to control erasing
251 procedure Draw_button_internal .erase_button_area .table$ .label$ .push
252 # Do not draw invisible buttons starting with #
253 goto NOBUTTON startsWith(.label$, "#")
255 # Scale rounding of rounded rectangles
257 .mm = demo Horizontal wc to mm... '.wc'
258 # Allow to overide ! skip directive
260 if startsWith(.label$, "+")
261 .label$ = right$(.label$, length(.label$)-1)
265 select Table '.table$'
266 .row = Search column... Label '.label$'
268 call emergency_table_exit Button Table '.table$' does not have a row with label '.label$'
271 # Perspective shift sizes
276 .shiftDown = 0.1*buttonbevel
277 .shiftX = -0.2*buttonbevel
278 .shiftY = 0.40*buttonbevel
281 # Set drawing parameters
282 .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
283 .topLineColorUp$ = "Black"
284 .topLineWidthUp = 1.5
285 .topBackGroundColorDown$ = "{0.89,0.89,0.94}"
286 .topLineColorDown$ = "{0.2,0.2,0.2}"
287 .topLineWidthDown = 2.0
288 .topBackGroundColorDisabled$ = "{0.85,0.85,0.85}"
289 .topLineColorDisabled$ = "{0.70,0.70,0.70}"
290 .topLineWidthDisabled = 1.5
291 .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
292 .flankLineColorUp$ = "{0.2,0.2,0.2}"
293 .flankLineWidthUp = 1.5
294 .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
295 .flankLineColorDown$ = .flankLineColorUp$
296 .flankLineWidthDown = 1.5
297 .buttonFontSize = defaultFontSize
300 .leftX = Get value... '.row' LeftX
301 .rightX = Get value... '.row' RightX
302 .lowY = Get value... '.row' LowY
303 .highY = Get value... '.row' HighY
304 .buttonText$ = Get value... '.row' Text
305 .buttonColor$ = Get value... '.row' Color
306 .buttonDraw$ = Get value... '.row' Draw
307 .buttonKey$ = Get value... '.row' Key
309 .noDraw = startsWith(.label$, "!") or (.leftX < 0) or (.rightX < 0) or (.lowY < 0) or (.highY < 0)
312 if index_regex(.buttonText$, "^![0-9\.]+!")
313 .rotation = extractNumber(.buttonText$, "!")
314 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
317 if .leftX = .rightX or .highY = .lowY
321 goto NOBUTTON .noDraw and not .forceDraw
323 # Replace button text with ALERT
325 .buttonText$ = alertText$
328 # Adapt font size to button size
329 .maxWidth = (.rightX - .leftX) - 2
330 .maxHeight = (.highY - .lowY) - 1
332 # Adapt size of button to length of text if necessary
333 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
334 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
335 if adjustFontSizeOnWidth.diff > 0
336 .rightX += adjustFontSizeOnWidth.diff/2
337 .leftX -= adjustFontSizeOnWidth.diff/2
339 call set_font_size '.buttonFontSize'
341 # Adapt size of button to length of text
342 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
343 if adjustFontSizeOnHeight.diff > 0
344 .lowY -= adjustFontSizeOnHeight.diff/2
345 .highY += adjustFontSizeOnHeight.diff/2
347 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
349 # With non-horizontal text, only change font size
350 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
351 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
354 # Reset and erase button area
356 demo Line width... 'defaultLineWidth'
358 .shiftRightX = .rightX - .shiftX
359 .shiftLowY = .lowY - .shiftY
361 if .erase_button_area
362 # Make erase area minutely larger
363 .eraseLeft = .shiftLeftX - 0.01
364 .eraseRight = .shiftRightX + 0.01
365 .eraseBottom = .shiftLowY - 0.01
366 .eraseTop = .shiftHighY + 0.01
367 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
370 # If label starts with "$", it is a text field. Then do not draw the button
371 if not startsWith(.label$, "$")
372 # Give some depth to button: Draw flank outline
373 if .shiftDown or .shiftX or .shiftY
375 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
376 demo Colour... '.flankLineColorUp$'
377 demo Line width... '.flankLineWidthUp'
379 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
380 demo Colour... '.flankLineColorDown$'
381 demo Line width... '.flankLineWidthDown'
383 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
386 # Button Down will shift the top perspective
388 # Draw the button top. Buttons with variable labels are treated differently
389 if .push = 0 or (.push >= 2 and index(.buttonText$, "$$$"))
390 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
391 demo Colour... '.topLineColorUp$'
392 demo Line width... '.topLineWidthUp'
394 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
395 demo Colour... '.topLineColorDisabled$'
396 demo Line width... '.topLineWidthDisabled'
400 .rightX += .shiftDown
404 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
405 demo Colour... '.topLineColorDown$'
406 demo Line width... '.topLineWidthDown'
408 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
411 # The button text and symbol
412 .horWC = demo Horizontal mm to wc... 10.0
413 .verWC = demo Vertical mm to wc... 10.0
415 .verCoeff = .horWC / .verWC
420 .centerX = (.leftX + .rightX)/2
421 .centerY = .lowY + 0.6*(.highY-.lowY)
422 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
423 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
424 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
425 .keyText$ = replace$(.buttonKey$, "\", "", 0)
426 .keyText$ = replace$(.keyText$, "-", "", 0)
429 .newText$ = replace_regex$(.buttonText$, "['.keyText$']", "#%&", 1)
432 .newText$ = .buttonText$
434 # Variable text field, read corresponding variable
435 if index(.newText$, "$$$")
436 .fieldName$ = replace_regex$(.label$, "^[!$#]", "", 0)
437 .fieldName$ = replace_regex$(.fieldName$, "^(.)", "\l\1", 0)
438 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
439 .newText$ = replace$(.newText$, "$$$", '.varPrefix$'.'.fieldName$'$, 0)
441 if .push = 1 or .push = -1
443 if .buttonColor$ = "Red"
444 .buttonColor$ = "Pink"
445 elsif .buttonColor$ = "Blue"
446 .buttonColor$ = "{0.5,0.5,1}"
448 .buttonColor$ = "Grey"
451 .buttonColor$ = "Maroon"
456 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
457 call set_font_size '.buttonFontSize'
458 demo Colour... '.buttonColor$'
461 .verticalAlignment$ = "Bottom"
463 .anchorY = .lowY + 0.5*(.highY-.lowY)
464 .verticalAlignment$ = "Half"
466 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
470 call set_font_size 'defaultFontSize'
472 demo Line width... 'defaultLineWidth'
477 procedure set_window_title .table$ .addedText$
478 select Table '.table$'
479 .row = Search column... Label !WindowTitle
481 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
483 .windowText$ = Get value... '.row' Text
484 call convert_praat_to_latin1 '.windowText$'
485 .windowText$ = convert_praat_to_latin1.text$
487 if index(.windowText$, "$$$")
488 .displayWindowText$ = replace$(.windowText$, "$$$", .addedText$, 0)
490 .displayWindowText$ = .windowText$ + .addedText$
493 demoWindowTitle(.displayWindowText$ )
496 # Handle language setting
497 procedure processLanguageCodes .table$ .label$
499 call Draw_button 'config$' Language_'config.language$' 0
500 call Draw_button 'config$' '.label$' 2
501 # Someone might have to use more than 2 chars for the language code
502 .numChars = length(.label$) - length("Language_")
503 .lang$ = right$(.label$, .numChars)
505 call set_language '.lang$'
509 procedure set_language .lang$
513 select Table 'buttons$'
518 select Table 'config$'
523 # See whether there is a custom language
524 sgc.customLanguage$ = ""
525 .langList = nocheck Create Strings as file list: "CustomLanguages", preferencesTableDir$+"/Config_*.Table"
526 # NOTE: The list might not exist!!!
527 if .langList = undefined
530 .numLanguages = Get number of strings
532 if .numLanguages <= 0
533 if not .langList = undefined
536 .langList = nocheck Create Strings as file list: "CustomLanguages", globaltablelists$+"/Config_*.Table"
537 if .langList = undefined
540 .numLanguages = Get number of strings
544 .configTable$ = Get string: 1
545 .startChar = rindex(.configTable$, "_")
546 sgc.customLanguage$ = right$(.configTable$, length(.configTable$) - .startChar)
547 sgc.customLanguage$ = left$(sgc.customLanguage$, index(sgc.customLanguage$, ".") -1)
549 if not .langList = undefined
555 call checkTable 'configTableName$'_'.lang$'
556 if checkTable.available
557 config.language$ = .lang$
559 config.language$ = "EN"
562 if config.language$ = "JA"
563 CJK font style preferences: "Japanese"
565 CJK font style preferences: "Chinese"
568 # Load buttons tables
569 call loadTable 'buttonsTableName$'
570 buttons$ = selected$("Table")
571 Append column... Text
573 Append column... Helptext
574 .numLabels = Get number of rows
575 call testLoadTable 'buttonsTableName$'_'config.language$'
576 if testLoadTable.table > 0
577 call loadTable 'buttonsTableName$'_'config.language$'
579 call loadTable 'buttonsTableName$'_EN
581 .buttonsLang$ = selected$("Table")
582 for .row to .numLabels
583 select Table 'buttons$'
584 .label$ = Get value... '.row' Label
585 call findLabel '.buttonsLang$' '.label$'
587 select Table '.buttonsLang$'
588 .valueText$ = Get value... 'findLabel.row' Text
589 .valueKey$ = Get value... 'findLabel.row' Key
590 .valueHelp$ = Get value... 'findLabel.row' Helptext
591 select Table 'buttons$'
592 Set string value... '.row' Text '.valueText$'
593 Set string value... '.row' Key '.valueKey$'
594 Set string value... '.row' Helptext '.valueHelp$'
595 elsif index(.label$, "_")
596 # Load alternative language table
597 .startChar = rindex(.label$, "_")
598 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
599 call loadTable 'buttonsTableName$'_'.otherLanguage$'
600 .otherbuttonsLang$ = selected$("Table")
601 call findLabel '.otherbuttonsLang$' '.label$'
603 select Table '.buttonsLang$'
604 .valueText$ = Get value... 'findLabel.row' Text
605 .valueKey$ = Get value... 'findLabel.row' Key
606 .valueHelp$ = Get value... 'findLabel.row' Helptext
607 select Table 'buttons$'
608 Set string value... '.row' Text '.valueText$'
609 Set string value... '.row' Key '.valueKey$'
610 Set string value... '.row' Helptext '.valueHelp$'
612 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
614 select Table '.otherbuttonsLang$'
617 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
620 select Table '.buttonsLang$'
623 # Load configuration table
624 call loadTable 'configTableName$'
625 config$ = selected$("Table")
626 .configTable = selected()
627 # Substitute or remove optional languages
628 .optRow = Search column: "Label", "!Language_???"
631 if sgc.customLanguage$ <> ""
632 .row = Search column: "Label", "Language_"+sgc.customLanguage$
634 if .row <= 0 and sgc.customLanguage$ <> ""
635 Set string value: .optRow, "Label", "Language_"+sgc.customLanguage$
637 .tableLength = Get number of rows
638 # Should never ever happen
642 Set string value: .optRow, "Label", "Language_EN"
648 Append column... Text
650 Append column... Helptext
651 .numLabels = Get number of rows
652 call testLoadTable 'configTableName$'_'config.language$'
653 if testLoadTable.table > 0
654 call loadTable 'configTableName$'_'config.language$'
656 call loadTable 'configTableName$'_EN
658 .configLang$ = selected$("Table")
659 for .row to .numLabels
660 select Table 'config$'
661 .label$ = Get value... '.row' Label
662 call findLabel '.configLang$' '.label$'
664 select Table '.configLang$'
665 .valueText$ = Get value... 'findLabel.row' Text
666 .valueKey$ = Get value... 'findLabel.row' Key
667 .valueHelp$ = Get value... 'findLabel.row' Helptext
668 select Table 'config$'
669 Set string value... '.row' Text '.valueText$'
670 Set string value... '.row' Key '.valueKey$'
671 Set string value... '.row' Helptext '.valueHelp$'
672 elsif index(.label$, "_")
673 .startChar = rindex(.label$, "_")
674 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
675 call loadTable 'configTableName$'_'.otherLanguage$'
676 .otherconfigLang$ = selected$("Table")
677 call findLabel '.otherconfigLang$' '.label$'
679 select Table '.otherconfigLang$'
680 .valueText$ = Get value... 'findLabel.row' Text
681 .valueKey$ = Get value... 'findLabel.row' Key
682 .valueHelp$ = Get value... 'findLabel.row' Helptext
683 select Table 'config$'
684 Set string value... '.row' Text '.valueText$'
685 Set string value... '.row' Key '.valueKey$'
686 Set string value... '.row' Helptext '.valueHelp$'
688 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
690 select Table '.otherconfigLang$'
693 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
696 select Table '.configLang$'
699 # Make language change visible
701 call Draw_config_page
706 ###############################################################
708 # Button Drawing Routines
710 ###############################################################
712 # A stub for buttons that do not have a drawing routine (yet)
713 procedure DrawNull .color$ .x .y .size
716 procedure DrawHelp .color$ .x .y .size
717 .currentFontSize = 24
720 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
721 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
722 call set_font_size '.currentFontSize'
723 demo Colour... '.color$'
724 demo Text... '.x' Centre '.y' Bottom ?
725 call set_font_size 'defaultFontSize'
728 ###############################################################
730 # Button Processing Routines
732 ###############################################################
734 # Search row in table on label
735 procedure findKey .table$ .label$
737 select Table '.table$'
738 .to$ = selected$("Table")
740 .numRows = Get number of rows
742 .currentKey$ = '.to$'$[.i, "Key"]
743 if .label$ = .currentKey$
749 if .row <= 0 and index(.label$, "_") <= 0
750 printline "'.label$'" is not a key in '.table$'
754 procedure findLabel .table$ .label$
756 select Table '.table$'
757 .to$ = selected$("Table")
759 .numRows = Get number of rows
761 .currentKey$ = '.to$'$[.i, "Label"]
762 if .label$ = .currentKey$
768 if .row <= 0 and index(.label$, "_") <= 0
769 call emergency_table_exit "'.label$'" is not a key in '.table$'
774 procedure buttonClicked table$ .x .y
776 select Table 'table$'
777 .bo$ = selected$("Table")
779 .numRows = Get number of rows
782 .leftX = '.bo$'[.i, "LeftX"]
783 .rightX = '.bo$'[.i, "RightX"]
784 .lowY = '.bo$'[.i, "LowY"]
785 .highY = '.bo$'[.i, "HighY"]
786 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
787 .label$ = '.bo$'$[.i, "Label"]
793 procedure keyPressed table$ .pressed$
796 if .pressed$ = "" and not demoShiftKeyPressed()
799 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
800 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
801 select Table 'table$'
802 .bo$ = selected$("Table")
804 .numRows = Get number of rows
807 .key$ = '.bo$'$[.i, "Key"]
808 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
809 .label$ = '.bo$'$[.i, "Label"]
815 procedure count_syllables
818 select sgc.currentWordlist
819 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
820 .sound$ = Get value... 'sgc.currentWord' Sound
821 call readPinyin 'sgc.currentWord'
822 .pinyin$ = readPinyin.pinyin$
824 call add_missing_neutral_tones '.pinyin$'
825 .pinyin$ = add_missing_neutral_tones.pinyin$
826 if index_regex(.pinyin$, "[0-9]") > 0
827 .number = length(replace_regex$(.pinyin$, "[^\d]+([\d]+)", "1", 0))
833 procedure play_sound .sound
835 if sgc.useAlternativePlayer and fileReadable(sgc.playCommandFile$)
836 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
838 Save as WAV file: .scratchFile$
839 .command$ < 'sgc.playCommandFile$'
840 .command$ = replace$(.command$, "[']", """", 0)
841 .command$ = replace$(.command$, "'newline$'", " ", 0)
843 system_nocheck bash -c -- ''.command$' "'.scratchFile$'"'
845 system_nocheck call '.command$' "'.scratchFile$'"
847 deleteFile(.scratchFile$)
855 procedure record_sound .recordingTime
856 if .recordingTime <= 0
857 .recordingTime = recordingTime
861 # NOTE: Some sound can be playing! This will not be stopped.
863 # There is a very nasty delay before the first recording starts, do a dummy record
864 if not variableExists("recordingInitialized") and not sgc.useAlternativeRecorder
865 call basic_sound_recording 'samplingFrequency' 0.1
867 recordingInitialized = 1
870 demo Paint circle... Red 5 95 2
873 # In Windows XP interaction between demoWaitForInput and Record Sound blocks drawing the feedback
874 # This code might be removed #
875 if windows and endsWith(build_SHA$, " XP")
876 # Display a pause window to flush the graphics buffer
877 beginPause ("DESTROY WINDOW ")
879 endPause ("DESTROY WINDOW ", 1)
881 demo Paint circle... Red 5 95 2
884 ##############################
885 call basic_sound_recording 'samplingFrequency' '.recordingTime'
887 demo Paint circle... White 5 95 2.5
888 call wipeArea 'wipeFeedbackArea$'
890 # Feedback on recording level
891 .extremum = Get absolute extremum... 0 0 None
892 .radius = 2 * .extremum
901 elsif .extremum >= 0.49
904 .green = .extremum / 0.5
906 .color$ = "{'.red','.green','.blue'}"
907 demo Colour... '.color$'
909 demo Draw circle... 5 95 '.radius'
913 demo Line width... 'defaultLineWidth'
917 Rename... Pronunciation
918 recordedSound$ = selected$("Sound")
919 sgc.recordedSound = selected("Sound")
922 select Sound 'recordedSound$'
923 sgc.recordedSound = selected("Sound")
925 # Cut out real sound from silences/noise
926 call sound_detection 'recordedSound$' 'soundMargin'
927 select Sound 'recordedSound$'
928 sgc.recordedSound = selected("Sound")
930 # Store audio if requested
931 if sgc.saveAudioOn and sgc.saveAudio$ <> ""
932 if sgc.savePerf$ <> "" and fileReadable(sgc.savePerf$)
934 select sgc.currentWordlist
935 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
936 call readPinyin 'sgc.currentWord'
937 .pinyin$ = readPinyin.pinyin$
938 .outputName$ = "'sgc.saveAudio$'/'.pinyin$'.wav"
939 select sgc.recordedSound
940 Save as WAV file: .outputName$
943 # The Audio directory disappeared
949 config.clearSummary = 0
950 config.audioName$ = ""
956 # Uses global variables!!!
957 procedure basic_sound_recording .samplingFrequency .recordingTime
958 # Use a different recorder program
959 if sgc.useAlternativeRecorder and fileReadable(sgc.recordCommandFile$)
960 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
961 .command$ < 'sgc.recordCommandFile$'
962 .command$ = replace$(.command$, "[']", """", 0)
963 .command$ = replace$(.command$, "'newline$'", " ", 0)
965 if unix and .recordingTime < 1
968 system_nocheck bash -c -- ''.command$' '.recordingTime''
970 system_nocheck call '.command$' '.recordingTime'
972 .sound = Read from file: .scratchFile$
973 deleteFile(.scratchFile$)
975 .sound = nocheck noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 '.samplingFrequency' '.recordingTime'
976 if .sound = undefined
977 .sound = Create Sound: "Pronunciation", 0, .recordingTime, .samplingFrequency, "0"
981 # The recorded sound should now be the selected object!!!
985 # Select real sound from recording
986 # Uses some global variable
987 procedure sound_detection .sound$ .margin
988 select Sound '.sound$'
989 .soundlength = Get total duration
990 .internalSilence = 2*.margin
992 # Silence and remove noise, DANGEROUS
993 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
994 Rename... Input'.sound$'
996 select TextGrid Input'.sound$'
997 .numberofIntervals = Get number of intervals... 1
998 if .numberofIntervals < 2
999 .numberofIntervals = 0
1002 # The code below will suppress noise, but also weak third tones
1003 # This handles the problem that third tones can be realized with
1004 # alternative cues, e.g, non-standard voice and very low levels
1006 # Remove buzzing and other obnoxious sounds (if switched on)
1007 for .i from 1 to .numberofIntervals
1008 select TextGrid Input'.sound$'
1009 .value$ = Get label of interval... 1 '.i'
1010 .begintime = Get starting point... 1 '.i'
1011 .endtime = Get end point... 1 '.i'
1014 if .value$ = "silent"
1015 select Sound '.sound$'
1016 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
1020 # Select target sound
1021 .maximumIntensity = -1
1023 for i from 1 to .numberofIntervals
1024 select TextGrid Input'.sound$'
1026 .value$ = Get label of interval... 1 'i'
1027 .begintime = Get starting point... 1 'i'
1028 .endtime = Get end point... 1 'i'
1030 if .value$ != "silent"
1031 if .begintime > .margin
1032 .begintime -= .margin
1036 if .endtime + .margin < .soundlength
1039 .endtime = .soundlength
1042 select Sound '.sound$'
1043 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
1044 Rename... Tmp'.sound$'
1046 .newIntensity = Get intensity (dB)
1047 if .newIntensity > .maximumIntensity
1048 if .maximumIntensity > 0
1049 select Sound New'.sound$'
1052 select Sound Tmp'.sound$'
1053 Rename... New'.sound$'
1054 .maximumIntensity = .newIntensity
1056 select Sound Tmp'.sound$'
1062 if .maximumIntensity > minimumIntensity
1063 select Sound '.sound$'
1065 select Sound New'.sound$'
1067 elsif .maximumIntensity > -1
1068 select Sound New'.sound$'
1071 select TextGrid Input'.sound$'
1074 select Sound '.sound$'
1077 procedure end_program
1078 call write_preferences ""
1085 ######################################################
1087 # Configuration Page
1089 ######################################################
1090 procedure config_page
1092 demoWindowTitle("Speak Good Chinese: Change settings")
1094 call Draw_config_page
1096 goto GOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1098 while (.label$ <> "Return") and demoWaitForInput()
1106 call buttonClicked 'config$' '.clickX' '.clickY'
1107 .label$ = buttonClicked.label$
1108 elsif demoKeyPressed()
1109 .pressed$ = demoKey$()
1110 call keyPressed 'config$' '.pressed$'
1111 .label$ = keyPressed.label$
1114 # You cannot select a text field
1115 if startsWith(.label$, "$")
1121 # Handle push button in process_config
1122 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
1125 if .label$ = "Return"
1135 procedure Draw_config_page
1138 if config.showBackground
1139 call draw_background Background
1142 call Draw_all_buttons 'config$'
1143 call set_window_title 'config$'
1144 # Set correct buttons (alert)
1145 call setConfigMainPage
1149 procedure process_config .label$ .clickX .clickY .pressed$
1150 if .label$ <> "" and not startsWith(.label$,"!")
1151 .label$ = replace_regex$(.label$, "^[#]", "", 0)
1152 .label$ = replace$(.label$, "_", " ", 0)
1155 'sgc2.logging$' call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1157 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1161 ###############################################################
1163 # Presenting help texts
1165 ###############################################################
1168 procedure help_loop .table$ .redrawProc$
1170 call write_help_title '.table$'
1174 call Draw_button '.table$' Help 2
1175 goto HELPGOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1178 while (.label$ <> "Help") and demoWaitForInput()
1183 call buttonClicked '.table$' '.clickX' '.clickY'
1184 .label$ = buttonClicked.label$
1185 elsif demoKeyPressed()
1186 .pressed$ = demoKey$()
1187 call keyPressed '.table$' '.pressed$'
1188 .label$ = keyPressed.label$
1191 if .label$ != "" and .label$ <> "Help"
1199 call Draw_button '.table$' Help 2
1200 call write_help_title '.table$'
1202 # Handle push button in process_config
1203 call write_help_text '.table$' '.label$'
1206 'sgc2.logging$' demo Erase all
1207 'sgc2.logging$' call '.redrawProc$'
1208 'sgc2.logging$' call write_help_title '.table$'
1209 'sgc2.logging$' call write_help_text '.table$' '.label$'
1216 call Draw_button '.table$' Help 0
1222 procedure write_help_text .table$ .label$
1223 call findLabel '.table$' '.label$'
1224 .row = findLabel.row
1225 select Table '.table$'
1228 call findLabel '.table$' Help
1229 .row = findLabel.row
1230 select Table '.table$'
1232 .helpText$ = Get value... '.row' Helptext
1233 .helpKey$ = Get value... '.row' Key
1234 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1235 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1236 if index_regex(.helpKey$, "\S")
1237 .helpText$ = .helpText$+" ("+.helpKey$+")"
1240 .leftX = Get value... '.row' LeftX
1241 .rightX = Get value... '.row' RightX
1242 .lowY = Get value... '.row' LowY
1243 .highY = Get value... '.row' HighY
1246 .currentHelpFontSize = defaultFontSize
1247 call set_font_size '.currentHelpFontSize'
1248 .helpTextSize = demo Text width (wc)... '.helpText$'
1252 .htXright = .htXleft + .helpTextSize + 5
1256 .htXleft = .htXright - .helpTextSize - 5
1261 .htYhigh = .htYlow + 7
1266 .htYlow = .htYhigh - 7
1271 # Adapt font size to horizontal dimensions
1273 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1274 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1275 if .htXleft < 0 or .htXright > 100
1277 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1279 call set_font_size '.currentHelpFontSize'
1281 # Adapt vertical dimensions to font height
1282 call points_to_wc '.currentHelpFontSize'
1283 .lineHeight = points_to_wc.wc
1284 if .lineHeight > .htYhigh - .htYlow - 4
1285 .htYhigh = .htYlow + .lineHeight + 4
1288 # Determine arrow endpoints
1290 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1293 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1294 .xend = (.htXleft+.htXright)/2
1297 .xtext = .htXleft + 2
1298 .ytext = .htYlow + 1
1301 .mm2wc = demo Horizontal mm to wc... 1
1302 .lineWidth = 2/.mm2wc
1303 demo Line width... '.lineWidth'
1304 demo Arrow size... '.lineWidth'
1305 demo Colour... 'sgc2.popUp_bordercolor$'
1306 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1307 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1308 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1309 demo Line width... 'defaultLineWidth'
1310 demo Arrow size... 1
1312 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1314 call set_font_size 'defaultFontSize'
1318 procedure write_help_title .table$
1319 # Set help text title
1321 call findLabel '.table$' Help
1322 .row = findLabel.row
1323 select Table '.table$'
1324 .helpTitle$ = Get value... '.row' Helptext
1325 .helpKey$ = Get value... '.row' Key
1326 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1327 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1328 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1331 .helpTitleFontSize = 14
1332 # Adapt size of button to length of text
1334 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1335 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1336 call set_font_size '.helpTitleFontSize'
1339 demo Select inner viewport... 0 100 0 100
1340 demo Axes... 0 100 0 100
1341 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1342 call set_font_size 'defaultFontSize'
1346 ###############################################################
1348 # Miscelaneous procedures
1350 ###############################################################
1351 procedure printPageToPrinter
1353 demo Print... 'printerName$' 'printerPresets$'
1357 procedure points_to_wc .points
1358 .mm = .points * 0.3527777778
1359 .wc = demo Vertical mm to wc... '.mm'
1362 procedure reset_viewport
1363 .low = viewportMargin
1364 .high = 100 - viewportMargin
1365 demo Select inner viewport... '.low' '.high' '.low' '.high'
1366 demo Axes... 0 100 0 100
1369 procedure set_font_size .fontSize
1371 demo Font size... '.fontSize'
1375 procedure wipeArea .areaCommand$
1380 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1382 call set_font_size '.currentFontSize'
1383 .textWidth = demo Text width (wc)... '.text$'
1384 while .textWidth > .maxWidth and .currentFontSize > 2
1385 .currentFontSize -= 0.5
1386 call set_font_size '.currentFontSize'
1387 .textWidth = demo Text width (wc)... '.text$'
1389 .diff = .textWidth - .maxWidth
1390 .newFontSize = .currentFontSize
1394 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1396 .radians = .rotation/360 * 2 * pi
1397 .horWC = demo Horizontal mm to wc... 10.0
1398 .verWC = demo Vertical mm to wc... 10.0
1400 .verCoeff = .verWC / .horWC
1404 call set_font_size '.currentFontSize'
1405 .textLength = demo Text width (wc)... '.text$'
1406 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1407 .currentFontSize -= 0.5
1408 call set_font_size '.currentFontSize'
1409 .textLength = demo Text width (wc)... '.text$'
1411 .diff = .textLength - .maxHeight
1412 .newFontSize = .currentFontSize
1416 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1418 call points_to_wc '.currentFontSize'
1419 .lineHeight = points_to_wc.wc
1420 while .lineHeight > .maxHeight and .currentFontSize > 2
1421 .currentFontSize -= 0.5
1422 call points_to_wc '.currentFontSize'
1423 .lineHeight = points_to_wc.wc
1425 .diff = .lineHeight - .maxHeight
1426 .newFontSize = .currentFontSize
1430 # Load a table with button info etc.
1431 # Load local tables if present. Else load
1432 # build-in scripted tables
1433 procedure loadTable .tableName$
1434 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1435 # Search for the table in local, preference, and global directories
1436 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1437 .table = Read from file... 'localTableDir$'/'.tableName$'.Table
1438 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1439 .table = Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1440 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1441 .table = Read from file... 'globaltablelists$'/'.tableName$'.Table
1442 # Load them from script
1443 elsif variableExists("procCreate'.tableVariableName$'$")
1444 call Create'.tableVariableName$'
1446 .table = selected("Table")
1448 call emergency_table_exit '.tableName$' cannot be found
1451 # Check whether this is a real table
1452 selectObject: .table
1453 .fullName$ = selected$ ()
1454 .type$ = extractWord$(.fullName$, "")
1455 if .type$ <> "Table"
1461 call emergency_table_exit '.tableFileName$' corrupted or cannot be found
1465 procedure testLoadTable .tableName$
1467 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1468 # Search for the table in local, preference, and global directories
1469 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1471 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1473 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1475 # Load them from script
1476 elsif variableExists("procCreate'.tableVariableName$'$")
1483 procedure checkTable .tableName$
1485 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1487 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1489 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1491 # Load them from script
1492 elsif variableExists("procCreate'.tableName$'$")
1499 # Create a pop-up window with text from a Text Table
1500 procedure write_text_table .table$
1507 # Get table with text and longest line
1509 call testLoadTable '.table$'
1510 if testLoadTable.table > 0
1511 call loadTable '.table$'
1512 .instructionText = selected()
1513 .numLines = Get number of rows
1515 goto ESCAPEwrite_text_table
1517 .instructionFontSize = 14
1518 .referenceText$ = ""
1524 select '.instructionText'
1525 .currentText$ = Get value... '.l' text
1526 # Expand variables, eg, 'praatVersion$'
1527 call expand_praat_variables '.currentText$'
1528 .currentText$ = expand_praat_variables.text$
1530 .font$ = Get value... '.l' font
1531 .fontSize = Get value... '.l' size
1532 call set_font_size '.fontSize'
1533 .textWidth = demo Text width (wc)... '.currentText$'
1534 if .fontSize > .maxFontSize
1535 .maxFontSize = .fontSize
1537 if .textWidth > .maxWidth
1538 .maxWidth = .textWidth
1539 .instructionFontSize = .fontSize
1543 select '.instructionText'
1544 .referenceText$ = Get value... '.maxLine' text
1545 .maxLineFont$ = Get value... '.maxLine' font
1546 .instructionFontSize = Get value... '.maxLine' size
1547 call set_font_size '.maxFontSize'
1549 # Adapt size of button to length of text
1550 .maxWidth = (.xright - .xleft) - 4
1551 .origFontSize = .instructionFontSize
1552 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1553 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1554 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1555 if adjustFontSizeOnWidth.diff > 0
1556 .xright += adjustFontSizeOnWidth.diff/4
1557 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1559 call set_font_size '.instructionFontSize'
1560 .fontSizeFactor = .instructionFontSize / .origFontSize
1562 .numRows = Get number of rows
1563 # Calculate length from number of lines.
1565 .midY = .yhigh - (.yhigh - .ylow)/2
1566 .yhigh = .midY + (.numRows+1) * .dy / 2
1567 .ylow = .yhigh - (.numRows+1) * .dy
1568 .textleft = .xleft + 2
1570 demo Line width... 8
1571 demo Colour... 'sgc2.popUp_bordercolor$'
1572 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1573 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1574 demo Line width... 'defaultLineWidth'
1576 .ytext = .yhigh - 2 - .dy
1578 select '.instructionText'
1579 .font$ = Get value... '.i' font
1580 .fontSize = Get value... '.i' size
1581 .font$ = extractWord$(.font$, "")
1583 .fontSize = floor(.fontSize*.fontSizeFactor)
1587 .line$ = Get value... '.i' text
1588 # Expand variables, eg, 'praatVersion$'
1589 call expand_praat_variables '.line$'
1590 .line$ = expand_praat_variables.text$
1593 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1597 call set_font_size 'defaultFontSize'
1599 select '.instructionText'
1602 label ESCAPEwrite_text_table
1606 # Create a pop-up window with text from an existing Table object
1607 procedure write_tabbed_table .table$ .labelTextTable$
1614 # Get table with text and longest line
1615 call testLoadTable '.table$'
1616 if testLoadTable.table <= 0
1617 call loadTable '.labelTextTable$'
1618 .labelText$ = selected$("Table")
1621 select Table '.table$'
1622 .tabbedText = selected()
1623 .numLines = Get number of rows
1624 .numCols = Get number of columns
1625 .font$ = defaultFont$
1626 .fontSize = defaultFontSize
1628 .widthCanvas = .xright - .xleft
1629 .dx = (.widthCanvas - 4) / (.numCols)
1633 call set_font_size '.fontSize'
1635 for .i from 0 to .numLines
1636 .xtext = .xleft + .dx / 2
1638 select '.tabbedText'
1639 .currentLabel$ = Get column label... '.j'
1641 .line$ = Get value... '.i' '.currentLabel$'
1643 .line$ = .currentLabel$
1644 select Table '.labelText$'
1645 call findLabel '.labelText$' '.line$'
1646 select Table '.labelText$'
1647 .line$ = Get value... 'findLabel.row' Text
1649 # Expand variables, eg, 'praatVersion$'
1650 call expand_praat_variables '.line$'
1651 .line$ = expand_praat_variables.text$
1652 .textWidth = demo Text width (wc)... '.line$'
1653 if .textWidth > .maxWidth
1654 .maxWidth = .textWidth
1658 if .dx > 1.2 * .maxWidth
1659 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1660 .xleft = 50 - .widthCanvas / 2
1661 .xright = 50 + .widthCanvas / 2
1662 .dx = (.widthCanvas - 4) / (.numCols)
1667 # Calculate length from number of lines.
1668 .dy = .lineHeight + 0.5
1669 .midY = .yhigh - (.yhigh - .ylow)/2
1670 .yhigh = .midY + (.numLines+2) * .dy / 2
1671 .ylow = .yhigh - (.numLines+2) * .dy
1672 .textleft = .xleft + 2
1674 demo Line width... 8
1675 demo Colour... 'sgc2.popUp_bordercolor$'
1676 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1677 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1678 demo Line width... 'defaultLineWidth'
1680 .ytext = .yhigh - 2 - .dy
1681 # First the column names, then the items
1682 for .i from 0 to .numLines
1683 .xtext = .textleft + .dx / 2
1685 select '.tabbedText'
1686 .currentLabel$ = Get column label... '.j'
1688 .line$ = Get value... '.i' '.currentLabel$'
1690 .line$ = .currentLabel$
1691 select Table '.labelText$'
1692 call findLabel '.labelText$' '.line$'
1693 select Table '.labelText$'
1694 .line$ = Get value... 'findLabel.row' Text
1696 # Expand variables, eg, 'praatVersion$'
1697 call expand_praat_variables '.line$'
1698 .line$ = expand_praat_variables.text$
1699 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1700 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1703 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1709 call set_font_size 'defaultFontSize'
1710 select Table '.labelText$'
1713 label ESCAPEwrite_tabbed_table
1716 # Create a pop-up window with a given text
1717 procedure write_text_popup .font$ .size .text$
1724 # Adapt size of button to length of text
1725 .maxWidth = (.xright - .xleft) - 4
1726 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1727 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1728 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1729 if adjustFontSizeOnWidth.diff > 0
1730 .xright += adjustFontSizeOnWidth.diff/4
1731 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1733 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1734 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1738 # Calculate length from number of lines.
1740 .midY = .yhigh - (.yhigh - .ylow)/2
1741 .yhigh = .midY + (.numRows+1) * .dy / 2
1742 .ylow = .yhigh - (.numRows+1) * .dy
1743 .textleft = .xleft + 2
1744 .xmid = (.textleft + .xright - 2)/2
1746 demo Line width... 8
1747 demo Colour... 'sgc2.popUp_bordercolor$'
1748 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1749 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1750 demo Line width... 'defaultLineWidth'
1752 .ytext = .yhigh - 2 - .dy
1754 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1758 call set_font_size 'defaultFontSize'
1761 # Write the background from a Text Table
1762 procedure draw_background .table$
1768 .defaultColour$ = "{0.9,0.9,0.9}"
1769 .defaultAlign$ = "centre"
1771 # Get table with text and longest line
1772 call loadTable '.table$'
1773 .backgroundText = selected()
1774 .numLines = Get number of rows
1775 .backgroundFontSize = 28
1776 .referenceText$ = ""
1783 select '.backgroundText'
1784 .currentText$ = Get value... '.l' text
1785 # Expand variables, eg, 'praatVersion$'
1786 call expand_praat_variables '.currentText$'
1787 .currentText$ = expand_praat_variables.text$
1789 .font$ = Get value... '.l' font
1790 .fontSize = Get value... '.l' size
1791 if .fontSize > .maxFontSize
1792 .maxFontSize = .fontSize
1794 if not startsWith(.font$, "!")
1795 call set_font_size '.fontSize'
1796 .textWidth = demo Text width (wc)... '.currentText$'
1797 if .textWidth > .maxWidth
1798 .maxWidth = .textWidth
1799 .backgroundFontSize = .fontSize
1807 select '.backgroundText'
1808 .referenceText$ = Get value... '.maxLine' text
1809 .maxLineFont$ = Get value... '.maxLine' font
1810 .backgroundFontSize = Get value... '.maxLine' size
1811 .backgroundFontColour$ = Get value... '.maxLine' colour
1812 call set_font_size '.maxFontSize'
1814 .maxFontSize = .backgroundFontSize
1817 # Adapt size of button to length of text
1818 .maxWidth = (.xright - .xleft) - 4
1819 .origFontSize = .backgroundFontSize
1820 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1821 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1822 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1823 call set_font_size '.backgroundFontSize'
1825 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1826 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1827 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1828 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1829 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1830 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1833 .numRows = Get number of rows
1834 # Calculate length from number of lines.
1836 .midY = .yhigh - (.yhigh - .ylow)/2
1837 .yhigh = .midY + (.textLines+1) * .dy / 2
1838 .ylow = .yhigh - (.textLines+1) * .dy
1839 .textleft = .xleft + 2
1840 .textright = .xright - 2
1841 .textmid = (.xright - .xleft)/2
1844 .ytext = .yhigh - 2 - .dy
1846 select '.backgroundText'
1847 .font$ = Get value... '.i' font
1848 .fontSize = Get value... '.i' size
1849 .fontColour$ = Get value... '.i' colour
1850 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1851 .fontAlign$ = Get value... '.i' align
1852 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1853 .line$ = Get value... '.i' text
1854 # Expand variables, eg, 'praatVersion$'
1855 call expand_praat_variables '.line$'
1856 .line$ = expand_praat_variables.text$
1859 .fontSize = floor(.fontSize*.fontSizeFactor)
1860 if not startsWith(.font$, "!")
1861 .font$ = extractWord$(.font$, "")
1863 if .fontAlign$ = "centre"
1865 elsif .fontAlign$ = "right"
1874 demo Colour... '.fontColour$'
1875 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1877 elsif .font$ = "!demo command"
1878 demo Colour... '.fontColour$'
1879 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1880 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1881 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1882 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1883 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1884 while index(.line$, "[[")
1885 .nextBracketOpen = index(.line$, "[[")
1886 .nextBracketOpen += 2
1887 .nextBracketClose = index(.line$, "]]")
1888 .bracketLength = .nextBracketClose - .nextBracketOpen
1890 if .bracketLength > 0
1891 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1892 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1893 if length(.expression$) > 0
1894 # Test expression for security, only allow explicitely defined functions
1895 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1896 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1897 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1898 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1899 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1900 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1901 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1902 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1903 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1904 if .testExpression$ = ""
1905 .calc = '.expression$'
1906 .result$ = "'.calc'"
1911 # Replace expression by result
1912 .lastLeft = .nextBracketOpen - 3
1913 .newLine$ = left$(.line$, .lastLeft)
1914 .newLine$ = .newLine$ + .result$
1915 .numCopy = length(.line$) - .nextBracketClose - 1
1916 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1924 call set_font_size 'defaultFontSize'
1926 select '.backgroundText'
1930 procedure convert_praat_to_utf8 .text$
1931 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1932 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1933 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1934 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1935 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1936 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1937 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1938 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1939 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1940 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1941 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1942 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1943 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1944 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1947 procedure convert_praat_to_latin1 .text$
1948 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1949 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1950 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1951 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1952 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1953 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1954 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1955 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1956 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1957 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1958 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1959 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1960 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1961 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1962 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1965 # Expand 'variable$' into the value of variable$.
1966 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1967 # Single quotes can be protected by \'
1968 procedure expand_praat_variables .text$
1969 if index(.text$, "'")
1970 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1971 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1972 .tempText$ = """"+.tempText$+""""
1973 # Check whether all the variables actually exist. Ignore any variable that does not exist
1974 .checkVars$ = .tempText$
1975 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1976 .start = index(.checkVars$, "+")
1977 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1978 .end = index(.checkVars$, "+")
1980 .variable$ = left$(.checkVars$, .end - 1)
1981 if not variableExists(.variable$)
1982 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1984 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1989 .text$ = '.tempText$'
1993 # Get a time stamp in normalized format
1994 procedure getTimeStamp
1995 .currentDateTime$ = date$()
1996 .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)
1999 # A table error, can be insiduously caused by an outdate preferences file!
2000 procedure emergency_table_exit .message$
2001 # If you come here as a user, your preferences file is borked
2002 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
2003 deleteFile(preferencesAppFile$)
2006 call get_feedback_text 'config.language$' Cancel
2007 call convert_praat_to_latin1 'get_feedback_text.text$'
2008 .cancelText$ = convert_praat_to_latin1.text$
2009 beginPause: "Fatal Error"
2011 endPause: .cancelText$, 1
2015 # Remove previous files from system
2016 procedure clean_up_sound
2017 if recordedSound$ = ""
2018 sgc.recordedSound = 0
2020 if sgc.recordedSound > 0
2021 select sgc.recordedSound
2024 sgc.recordedSound = 0
2026 if te.recordedPitch > 0
2027 select te.recordedPitch
2029 te.recordedPitch = 0
2031 if sgc.alignedTextGrid > 0
2032 select sgc.alignedTextGrid
2034 sgc.alignedTextGrid = -1
2038 # Safely read a table
2039 procedure readTable .filename$
2041 if .filename$ <> "" and fileReadable(.filename$) and index_regex(.filename$, "(?i\.(tsv|table|csv))$") > 0
2042 if index_regex(.filename$, "(?i\.(csv))$") > 0
2043 .tableID = Read Table from comma-separated file: .filename$
2044 elsif index_regex(.filename$, "(?i\.(tsv))$") > 0
2045 .tableID = nocheck Read Table from tab-separated file: .filename$
2047 .tableID = nocheck Read from file... '.filename$'
2049 if .tableID = undefined or .tableID <= 0
2052 .fullName$ = selected$ ()
2053 .type$ = extractWord$(.fullName$, "")
2054 if .type$ <> "Table"
2062 # Read feedback table and get keyed text
2063 procedure get_feedback_text .language$ .key$
2064 if not endsWith(feedbackTableName$, "_'.language$'")
2065 if feedbackTableName$ <> ""
2066 select Table 'feedbackTableName$'
2069 call testLoadTable 'feedbackTablePrefix$'_'.language$'
2070 if testLoadTable.table > 0
2071 call loadTable 'feedbackTablePrefix$'_'.language$'
2073 call loadTable 'feedbackTablePrefix$'_EN
2075 feedbackTableName$ = selected$("Table")
2077 call findKey 'feedbackTableName$' '.key$'
2079 select Table 'feedbackTableName$'
2080 .text$ = Get value... '.row' Text
2081 # Expand variables, eg, 'praatVersion$'
2082 call expand_praat_variables '.text$'
2083 .text$ = expand_praat_variables.text$
2087 # Read evaluation table and get keyed text. Only praat converted Text
2088 procedure get_evaluation_text .language$ .key$
2089 if not endsWith(evaluationTableName$, "_'.language$'")
2090 if evaluationTableName$ <> ""
2091 select Table 'evaluationTableName$'
2094 call testLoadTable 'evaluationTablePrefix$'_'.language$'
2095 if testLoadTable.table > 0
2096 call loadTable 'evaluationTablePrefix$'_'.language$'
2098 call loadTable 'evaluationTablePrefix$'_EN
2100 evaluationTableName$ = selected$("Table")
2102 call findLabel 'evaluationTableName$' '.key$'
2103 .row = findLabel.row
2104 select Table 'evaluationTableName$'
2105 .text$ = Get value... '.row' Text
2106 # Expand variables, eg, 'praatVersion$'
2107 call expand_praat_variables '.text$'
2108 .rawtext$ = expand_praat_variables.text$
2109 call convert_praat_to_latin1 '.rawtext$'
2110 .text$ = convert_praat_to_latin1.text$
2113 # Read all the relevant evaluation labels and put them in "eval.<label>$" variables
2114 procedure get_evaluation_table_labels .language$
2115 call get_evaluation_text '.language$' Performance
2116 eval.performance$ = get_evaluation_text.text$
2117 call get_evaluation_text '.language$' Pinyin
2118 eval.pinyin$ = get_evaluation_text.text$
2119 call get_evaluation_text '.language$' Correct
2120 eval.correct$ = get_evaluation_text.text$
2121 call get_evaluation_text '.language$' Wrong
2122 eval.wrong$ = get_evaluation_text.text$
2123 call get_evaluation_text '.language$' Total
2124 eval.total$ = get_evaluation_text.text$
2125 call get_evaluation_text '.language$' High
2126 eval.high$ = get_evaluation_text.text$
2127 call get_evaluation_text '.language$' Low
2128 eval.low$ = get_evaluation_text.text$
2129 call get_evaluation_text '.language$' Wide
2130 eval.wide$ = get_evaluation_text.text$
2131 call get_evaluation_text '.language$' Narrow
2132 eval.narrow$ = get_evaluation_text.text$
2133 call get_evaluation_text '.language$' Unknown
2134 eval.unknown$ = get_evaluation_text.text$
2135 call get_evaluation_text '.language$' Commented
2136 eval.commented$ = get_evaluation_text.text$
2137 call get_evaluation_text '.language$' Level
2138 eval.level$ = get_evaluation_text.text$
2139 call get_evaluation_text '.language$' Time
2140 eval.time$ = get_evaluation_text.text$
2141 call get_evaluation_text '.language$' Wordlist
2142 eval.wordlist$ = get_evaluation_text.text$
2147 procedure saveLogOfActivity .command$
2148 # Do not log in binary!
2150 createDirectory(preferencesLogDir$)
2151 appendFileLine: "'preferencesLogDir$'/'logtimeStamp$'.log", .command$
2155 # Replay a log file with commands sgc.replaySleep inserts a pause
2156 procedure replaySGC2LogFunction
2157 if not variableExists("sgc.replaySleep")
2158 sgc.replaySleep = -1
2160 # Do not replay in binary!
2162 # Ask for the input file
2163 .filename$ = chooseReadFile$ ("Select file to replay")
2164 if .filename$ <> "" and fileReadable(.filename$)
2165 .replayFile = Read Strings from raw text file: .filename$
2166 if .replayFile <> undefined
2168 if sgc.replaySleep > 0
2169 call basic_sound_recording 'samplingFrequency' 'sgc.replaySleep'
2173 .numStrings = Get number of strings
2174 for .l to .numStrings
2176 .line$ = Get string: .l
2177 if index_regex(.line$, "process(MainPage|Config)(Help|Config|Return|Quit)")
2178 if index(.line$, "processMainPageConfig")
2179 .line$ = "call Draw_config_page"
2180 elsif index_regex(.line$, "processConfigReturn")
2181 .line$ = "call init_window"
2182 elsif index_regex(.line$, "processMainPageHelp")
2183 .line$ = "call init_window"
2184 elsif index_regex(.line$, "processConfigHelp")
2185 .line$ = "call Draw_config_page"
2187 .line$ = "# " + .line$
2190 if index_regex(.line$, "[a-zA-Z]") > 0 and index_regex(.line$, "\s*#") <= 0
2195 if sgc.replaySleep > 0
2196 call basic_sound_recording 'samplingFrequency' 'sgc.replaySleep'