| blob | 35c4c47ab79c3b06f94a1c0089ae235593bda857 |
1 #
2 # SpeakGoodChinese 2.0
3 #
4 # Master Praat script
5 #
6 # SpeakGoodChinese: sgc2.praat is the master GUI of SpeakGoodChinese
7 # It is written in Praat script for the Demo window
8 #
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
13 #
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.
18 #
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.
23 #
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
27 #
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$")
33 build_SHA$ = "-"
34 endif
36 # These are simply "useful" defaults
37 # The local Table directory only exists when running SGC as a script
38 if build_SHA$ = "-"
39 localTableDir$ = "Data"
40 else
41 localTableDir$ = ""
42 endif
43 buttonsTableName$ = "MainPage"
44 configTableName$ = "Config"
45 buttons$ = ""
46 config$ = ""
47 recordedSound$ = ""
48 sgc.recordedSound = 0
49 te.recordedPitch = 0
50 te.buttonPressValue = 0
51 samplingFrequency = 44100
52 recordingTime = 2
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
63 if unix
64 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
65 else
66 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
67 endif
68 else
69 # It has to go somewhere. Make a subdirectory in the current preferences directory
70 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
71 endif
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
77 noiseThresshold = -30
78 minimumPitch = 60
79 soundMargin = 0.25
80 minimumIntensity = 30
82 # Set up button height
83 buttonbevel = 0
85 # Define canvas
86 viewportMargin = 5
87 defaultFontSize = 12
88 defaultFont$ = "Helvetica"
89 defaultLineWidth = 1
91 # Set up system
92 call reset_viewport
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
103 include Config.praat
105 # A function:
106 # replaySGC2LogFunction$ = "replaySGC2LogFunction"
107 # procedure replaySGC2LogFunction
108 # ....
109 # Test commands
110 # endproc
111 #
112 # include sgc2.praat
113 #
114 'replaySGC2Log$'
116 # Start instruction loop
117 while demoWaitForInput()
118 .label$ = ""
119 .clickX = -1
120 .clickY = -1
121 .pressed$ = ""
122 if demoClicked()
123 .clickX = demoX()
124 .clickY = demoY()
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$
131 endif
133 # You cannot select a text field
134 if startsWith(.label$, "$")
135 .label$ = ""
136 endif
138 # Do things
139 if .label$ != ""
140 te.buttonPressValue = 0
141 # Push button down
142 call Draw_button 'buttons$' '.label$' 1
143 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
144 # push button up
145 call Draw_button 'buttons$' '.label$' 'te.buttonPressValue'
146 endif
147 endwhile
149 call end_program
152 ########################################################
153 #
154 # Definitions of procedures
155 #
156 ########################################################
157 #
158 # Do what is asked
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)
165 # log activity
166 'sgc2.logging$' call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
168 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
169 endif
170 endproc
172 # Intialize buttons
173 procedure init_buttons
174 noerase = 1
175 call Draw_all_buttons 'buttons$'
176 noerase = 0
177 endproc
179 # Draw all buttons
180 noerase = 0
181 procedure Draw_all_buttons .table$
182 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
183 select Table '.table$'
184 .numRows = Get number of rows
186 for .row to .numRows
187 .label$ = Get value... '.row' Label
188 if not startsWith(.label$, "!")
189 .pressed = 0
190 # Determine the "pressed" state of a button
191 # A variable with the same name as the button will act as a
192 # "pressed state"
193 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
194 # Simple boolean variables
195 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
196 # True: Pressed
197 if '.variableName$' > 0
198 .pressed = 2
199 # <0: Grayed out
200 elsif '.variableName$' < 0
201 .pressed = -1
202 endif
203 elsif index(.variableName$, "_") <= 0 and variableExists("'.variableName$'$")
204 # Non zero: Pressed
205 if '.variableName$'$ <> "" and '.variableName$'$ <> "0"
206 .pressed = 2
207 endif
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$
213 # Is it a string?
214 if variableExists(.generalVar$+"$")
215 .currentVariableName$ = .generalVar$ + "$"
216 endif
217 # Remove one level of indirection
218 if variableExists(.currentVariableName$)
219 if index(.currentVariableName$, "$")
220 .currentVariableName$ = '.currentVariableName$'
221 else
222 .currentValue = '.currentVariableName$'
223 .currentVariableName$ = "'.currentValue'"
224 endif
225 # Remove next level of indirection
226 .currentContent$ = "'.currentVariableName$'"
227 if .currentContent$ = "_DISABLED_"
228 .pressed = -1
229 endif
230 # Reconstruct label from current values
231 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
232 # Set PRESSED from label
233 if .variableName$ = .currentLabelValue$
234 .pressed = 2
235 endif
236 endif
237 endif
238 # You did erase everything before you started here? So do not do that again
239 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
240 endif
241 endfor
242 endproc
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'
248 endproc
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
256 .wc = 1
257 .mm = demo Horizontal wc to mm... '.wc'
258 # Allow to overide ! skip directive
259 .forceDraw = 0
260 if startsWith(.label$, "+")
261 .label$ = right$(.label$, length(.label$)-1)
262 .forceDraw = 1
263 endif
265 select Table '.table$'
266 .row = Search column... Label '.label$'
267 if .row < 1
268 call emergency_table_exit Button Table '.table$' does not have a row with label '.label$'
269 endif
271 # Perspective shift sizes
272 .shiftDown = 0
273 .shiftX = 0
274 .shiftY = 0
275 if buttonbevel <> 0
276 .shiftDown = 0.1*buttonbevel
277 .shiftX = -0.2*buttonbevel
278 .shiftY = 0.40*buttonbevel
279 endif
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
299 # Get button values
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)
311 .rotation = 0
312 if index_regex(.buttonText$, "^![0-9\.]+!")
313 .rotation = extractNumber(.buttonText$, "!")
314 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
315 endif
317 goto NOBUTTON .noDraw and not .forceDraw
319 # Replace button text with ALERT
320 if .push = 3
321 .buttonText$ = alertText$
322 endif
324 # Adapt font size to button size
325 .maxWidth = (.rightX - .leftX) - 2
326 .maxHeight = (.highY - .lowY) - 1
327 if .rotation = 0
328 # Adapt size of button to length of text if necessary
329 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
330 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
331 if adjustFontSizeOnWidth.diff > 0
332 .rightX += adjustFontSizeOnWidth.diff/2
333 .leftX -= adjustFontSizeOnWidth.diff/2
334 endif
335 call set_font_size '.buttonFontSize'
337 # Adapt size of button to length of text
338 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
339 if adjustFontSizeOnHeight.diff > 0
340 .lowY -= adjustFontSizeOnHeight.diff/2
341 .highY += adjustFontSizeOnHeight.diff/2
342 endif
343 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
344 else
345 # With non-horizontal text, only change font size
346 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
347 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
348 endif
350 # Reset and erase button area
351 call reset_viewport
352 demo Line width... 'defaultLineWidth'
353 .shiftLeftX = .leftX
354 .shiftRightX = .rightX - .shiftX
355 .shiftLowY = .lowY - .shiftY
356 .shiftHighY = .highY
357 if .erase_button_area
358 # Make erase area minutely larger
359 .eraseLeft = .shiftLeftX - 0.01
360 .eraseRight = .shiftRightX + 0.01
361 .eraseBottom = .shiftLowY - 0.01
362 .eraseTop = .shiftHighY + 0.01
363 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
364 endif
366 # If label starts with "$", it is a text field. Then do not draw the button
367 if not startsWith(.label$, "$")
368 # Give some depth to button: Draw flank outline
369 if .shiftDown or .shiftX or .shiftY
370 if .push <= 0
371 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
372 demo Colour... '.flankLineColorUp$'
373 demo Line width... '.flankLineWidthUp'
374 else
375 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
376 demo Colour... '.flankLineColorDown$'
377 demo Line width... '.flankLineWidthDown'
378 endif
379 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
380 endif
382 # Button Down will shift the top perspective
384 # Draw the button top
385 if .push = 0
386 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
387 demo Colour... '.topLineColorUp$'
388 demo Line width... '.topLineWidthUp'
389 elsif .push < 0
390 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
391 demo Colour... '.topLineColorDisabled$'
392 demo Line width... '.topLineWidthDisabled'
393 else
394 # Button Down
395 .leftX += .shiftDown
396 .rightX += .shiftDown
397 .lowY -= .shiftDown
398 .highY -= .shiftDown
400 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
401 demo Colour... '.topLineColorDown$'
402 demo Line width... '.topLineWidthDown'
403 endif
404 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
405 endif
407 # The button text and symbol
408 .horWC = demo Horizontal mm to wc... 10.0
409 .verWC = demo Vertical mm to wc... 10.0
410 if .verWC > 0
411 .verCoeff = .horWC / .verWC
412 else
413 .verCoeff = 1
414 endif
416 .centerX = (.leftX + .rightX)/2
417 .centerY = .lowY + 0.6*(.highY-.lowY)
418 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
419 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
420 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
421 .keyText$ = replace$(.buttonKey$, "\", "", 0)
422 .keyText$ = replace$(.keyText$, "-", "", 0)
423 if .keyText$ <> "" and index_regex(.keyText$, "[\[\]]") <= 0
424 .newText$ = replace_regex$(.buttonText$, "['.keyText$']", "#%&", 1)
425 endif
426 if .newText$ = ""
427 .newText$ = .buttonText$
428 endif
429 # Variable text field, read corresponding variable
430 if index(.newText$, "$$$")
431 .fieldName$ = replace_regex$(.label$, "^[!$#]", "", 0)
432 .fieldName$ = replace_regex$(.fieldName$, "^(.)", "\l\1", 0)
433 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
434 .newText$ = replace$(.newText$, "$$$", '.varPrefix$'.'.fieldName$'$, 0)
435 endif
436 if .push = 1 or .push = -1
437 demo Grey
438 if .buttonColor$ = "Red"
439 .buttonColor$ = "Pink"
440 elsif .buttonColor$ = "Blue"
441 .buttonColor$ = "{0.5,0.5,1}"
442 else
443 .buttonColor$ = "Grey"
444 endif
445 elsif .push >= 2
446 .buttonColor$ = "Maroon"
447 else
448 demo Colour... Black
449 endif
451 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
452 call set_font_size '.buttonFontSize'
453 demo Colour... '.buttonColor$'
454 if .rotation = 0
455 .anchorY = .lowY
456 .verticalAlignment$ = "Bottom"
457 else
458 .anchorY = .lowY + 0.5*(.highY-.lowY)
459 .verticalAlignment$ = "Half"
460 endif
461 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
462 demoShow()
464 # Reset
465 call set_font_size 'defaultFontSize'
466 demo Black
467 demo Line width... 'defaultLineWidth'
469 label NOBUTTON
470 endproc
472 procedure set_window_title .table$ .addedText$
473 select Table '.table$'
474 .row = Search column... Label !WindowTitle
475 if .row < 1
476 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
477 endif
478 .windowText$ = Get value... '.row' Text
479 call convert_praat_to_latin1 '.windowText$'
480 .windowText$ = convert_praat_to_latin1.text$
482 if index(.windowText$, "$$$")
483 .displayWindowText$ = replace$(.windowText$, "$$$", .addedText$, 0)
484 else
485 .displayWindowText$ = .windowText$ + .addedText$
486 endif
488 demoWindowTitle(.displayWindowText$ )
489 endproc
491 # Handle language setting
492 procedure processLanguageCodes .table$ .label$
493 .table$ = "Config"
494 call Draw_button 'config$' Language_'config.language$' 0
495 call Draw_button 'config$' '.label$' 2
496 # Someone might have to use more than 2 chars for the language code
497 .numChars = length(.label$) - length("Language_")
498 .lang$ = right$(.label$, .numChars)
499 # Load new tables
500 call set_language '.lang$'
501 endproc
503 # Set the language
504 procedure set_language .lang$
505 .redraw_config = 0
506 # Remove old tables
507 if buttons$ <> ""
508 select Table 'buttons$'
509 Remove
510 .redraw_config = 1
511 endif
512 if config$ <> ""
513 select Table 'config$'
514 Remove
515 .redraw_config = 1
516 endif
518 # See whether there is a custom language
519 sgc.customLanguage$ = ""
520 .langList = nocheck Create Strings as file list: "CustomLanguages", preferencesTableDir$+"/Config_*.Table"
521 # NOTE: The list might not exist!!!
522 if .langList = undefined
523 .numLanguages = -1
524 else
525 .numLanguages = Get number of strings
526 endif
527 if .numLanguages <= 0
528 if not .langList = undefined
529 Remove
530 endif
531 .langList = nocheck Create Strings as file list: "CustomLanguages", globaltablelists$+"/Config_*.Table"
532 if .langList = undefined
533 .numLanguages = -1
534 else
535 .numLanguages = Get number of strings
536 endif
537 endif
538 if .numLanguages > 0
539 .configTable$ = Get string: 1
540 .startChar = rindex(.configTable$, "_")
541 sgc.customLanguage$ = right$(.configTable$, length(.configTable$) - .startChar)
542 sgc.customLanguage$ = left$(sgc.customLanguage$, index(sgc.customLanguage$, ".") -1)
543 endif
544 if not .langList = undefined
545 select .langList
546 Remove
547 endif
549 # Set language
550 call checkTable 'configTableName$'_'.lang$'
551 if checkTable.available
552 config.language$ = .lang$
553 else
554 config.language$ = "EN"
555 endif
557 if config.language$ = "JA"
558 CJK font style preferences: "Japanese"
559 else
560 CJK font style preferences: "Chinese"
561 endif
563 # Load buttons tables
564 call loadTable 'buttonsTableName$'
565 buttons$ = selected$("Table")
566 Append column... Text
567 Append column... Key
568 Append column... Helptext
569 .numLabels = Get number of rows
570 call testLoadTable 'buttonsTableName$'_'config.language$'
571 if testLoadTable.table > 0
572 call loadTable 'buttonsTableName$'_'config.language$'
573 else
574 call loadTable 'buttonsTableName$'_EN
575 endif
576 .buttonsLang$ = selected$("Table")
577 for .row to .numLabels
578 select Table 'buttons$'
579 .label$ = Get value... '.row' Label
580 call findLabel '.buttonsLang$' '.label$'
581 if findLabel.row > 0
582 select Table '.buttonsLang$'
583 .valueText$ = Get value... 'findLabel.row' Text
584 .valueKey$ = Get value... 'findLabel.row' Key
585 .valueHelp$ = Get value... 'findLabel.row' Helptext
586 select Table 'buttons$'
587 Set string value... '.row' Text '.valueText$'
588 Set string value... '.row' Key '.valueKey$'
589 Set string value... '.row' Helptext '.valueHelp$'
590 elsif index(.label$, "_")
591 # Load alternative language table
592 .startChar = rindex(.label$, "_")
593 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
594 call loadTable 'buttonsTableName$'_'.otherLanguage$'
595 .otherbuttonsLang$ = selected$("Table")
596 call findLabel '.otherbuttonsLang$' '.label$'
597 if findLabel.row > 0
598 select Table '.buttonsLang$'
599 .valueText$ = Get value... 'findLabel.row' Text
600 .valueKey$ = Get value... 'findLabel.row' Key
601 .valueHelp$ = Get value... 'findLabel.row' Helptext
602 select Table 'buttons$'
603 Set string value... '.row' Text '.valueText$'
604 Set string value... '.row' Key '.valueKey$'
605 Set string value... '.row' Helptext '.valueHelp$'
606 else
607 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
608 endif
609 select Table '.otherbuttonsLang$'
610 Remove
611 else
612 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
613 endif
614 endfor
615 select Table '.buttonsLang$'
616 Remove
618 # Load configuration table
619 call loadTable 'configTableName$'
620 config$ = selected$("Table")
621 .configTable = selected()
622 # Substitute or remove optional languages
623 .optRow = Search column: "Label", "!Language_???"
624 if .optRow > 0
625 .row = -1
626 if sgc.customLanguage$ <> ""
627 .row = Search column: "Label", "Language_"+sgc.customLanguage$
628 endif
629 if .row <= 0 and sgc.customLanguage$ <> ""
630 Set string value: .optRow, "Label", "Language_"+sgc.customLanguage$
631 else
632 .tableLength = Get number of rows
633 # Should never ever happen
634 if .tableLength > 1
635 Remove row: .optRow
636 else
637 Set string value: .optRow, "Label", "Language_EN"
638 endif
639 endif
640 endif
642 select .configTable
643 Append column... Text
644 Append column... Key
645 Append column... Helptext
646 .numLabels = Get number of rows
647 call testLoadTable 'configTableName$'_'config.language$'
648 if testLoadTable.table > 0
649 call loadTable 'configTableName$'_'config.language$'
650 else
651 call loadTable 'configTableName$'_EN
652 endif
653 .configLang$ = selected$("Table")
654 for .row to .numLabels
655 select Table 'config$'
656 .label$ = Get value... '.row' Label
657 call findLabel '.configLang$' '.label$'
658 if findLabel.row > 0
659 select Table '.configLang$'
660 .valueText$ = Get value... 'findLabel.row' Text
661 .valueKey$ = Get value... 'findLabel.row' Key
662 .valueHelp$ = Get value... 'findLabel.row' Helptext
663 select Table 'config$'
664 Set string value... '.row' Text '.valueText$'
665 Set string value... '.row' Key '.valueKey$'
666 Set string value... '.row' Helptext '.valueHelp$'
667 elsif index(.label$, "_")
668 .startChar = rindex(.label$, "_")
669 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
670 call loadTable 'configTableName$'_'.otherLanguage$'
671 .otherconfigLang$ = selected$("Table")
672 call findLabel '.otherconfigLang$' '.label$'
673 if findLabel.row > 0
674 select Table '.otherconfigLang$'
675 .valueText$ = Get value... 'findLabel.row' Text
676 .valueKey$ = Get value... 'findLabel.row' Key
677 .valueHelp$ = Get value... 'findLabel.row' Helptext
678 select Table 'config$'
679 Set string value... '.row' Text '.valueText$'
680 Set string value... '.row' Key '.valueKey$'
681 Set string value... '.row' Helptext '.valueHelp$'
682 else
683 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
684 endif
685 select Table '.otherconfigLang$'
686 Remove
687 else
688 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
689 endif
690 endfor
691 select Table '.configLang$'
692 Remove
694 # Make language change visible
695 if .redraw_config
696 call Draw_config_page
697 endif
699 endproc
701 ###############################################################
702 #
703 # Button Drawing Routines
704 #
705 ###############################################################
707 # A stub for buttons that do not have a drawing routine (yet)
708 procedure DrawNull .color$ .x .y .size
709 endproc
711 procedure DrawHelp .color$ .x .y .size
712 .currentFontSize = 24
713 .y -= .size
714 .maxHeight = 2*.size
715 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
716 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
717 call set_font_size '.currentFontSize'
718 demo Colour... '.color$'
719 demo Text... '.x' Centre '.y' Bottom ?
720 call set_font_size 'defaultFontSize'
721 endproc
723 ###############################################################
724 #
725 # Button Processing Routines
726 #
727 ###############################################################
729 # Search row in table on label
730 procedure findKey .table$ .label$
731 .row = 0
732 select Table '.table$'
733 .to$ = selected$("Table")
734 .to$ = "Table_"+.to$
735 .numRows = Get number of rows
736 for .i to .numRows
737 .currentKey$ = '.to$'$[.i, "Key"]
738 if .label$ = .currentKey$
739 .row = .i
740 goto KEYFOUND
741 endif
742 endfor
743 label KEYFOUND
744 if .row <= 0 and index(.label$, "_") <= 0
745 printline "'.label$'" is not a key in '.table$'
746 endif
747 endproc
749 procedure findLabel .table$ .label$
750 .row = 0
751 select Table '.table$'
752 .to$ = selected$("Table")
753 .to$ = "Table_"+.to$
754 .numRows = Get number of rows
755 for .i to .numRows
756 .currentKey$ = '.to$'$[.i, "Label"]
757 if .label$ = .currentKey$
758 .row = .i
759 goto LABELFOUND
760 endif
761 endfor
762 label LABELFOUND
763 if .row <= 0 and index(.label$, "_") <= 0
764 call emergency_table_exit "'.label$'" is not a key in '.table$'
765 endif
766 endproc
768 # Get the label
769 procedure buttonClicked table$ .x .y
770 .label$ = ""
771 select Table 'table$'
772 .bo$ = selected$("Table")
773 .bo$ = "Table_"+.bo$
774 .numRows = Get number of rows
775 for .i to .numRows
776 if .label$ = ""
777 .leftX = '.bo$'[.i, "LeftX"]
778 .rightX = '.bo$'[.i, "RightX"]
779 .lowY = '.bo$'[.i, "LowY"]
780 .highY = '.bo$'[.i, "HighY"]
781 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
782 .label$ = '.bo$'$[.i, "Label"]
783 endif
784 endif
785 endfor
786 endproc
788 procedure keyPressed table$ .pressed$
789 .label$ = ""
790 # Magic
791 if .pressed$ = "" and not demoShiftKeyPressed()
792 .label$ = "Refresh"
793 endif
794 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
795 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
796 select Table 'table$'
797 .bo$ = selected$("Table")
798 .bo$ = "Table_"+.bo$
799 .numRows = Get number of rows
800 for .i to .numRows
801 if .label$ = ""
802 .key$ = '.bo$'$[.i, "Key"]
803 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
804 .label$ = '.bo$'$[.i, "Label"]
805 endif
806 endif
807 endfor
808 endproc
810 procedure count_syllables
811 .number = 0
812 .pinyin$ = ""
813 select sgc.currentWordlist
814 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
815 .sound$ = Get value... 'sgc.currentWord' Sound
816 call readPinyin 'sgc.currentWord'
817 .pinyin$ = readPinyin.pinyin$
818 endif
819 call add_missing_neutral_tones '.pinyin$'
820 .pinyin$ = add_missing_neutral_tones.pinyin$
821 if index_regex(.pinyin$, "[0-9]") > 0
822 .number = length(replace_regex$(.pinyin$, "[^\d]+([\d]+)", "1", 0))
823 elsif .pinyin$ <> ""
824 .number = 1
825 endif
826 endproc
828 procedure play_sound .sound
829 if .sound > 0
830 if sgc.useAlternativePlayer and fileReadable(sgc.playCommandFile$)
831 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
832 select .sound
833 Save as WAV file: .scratchFile$
834 .command$ < 'sgc.playCommandFile$'
835 .command$ = replace$(.command$, "[']", """", 0)
836 .command$ = replace$(.command$, "'newline$'", " ", 0)
837 if unix or macintosh
838 system_nocheck bash -c -- ''.command$' "'.scratchFile$'"'
839 elsif windows
840 system_nocheck call '.command$' "'.scratchFile$'"
841 endif
842 deleteFile(.scratchFile$)
843 else
844 select .sound
845 Play
846 endif
847 endif
848 endproc
850 procedure record_sound .recordingTime
851 if .recordingTime <= 0
852 .recordingTime = recordingTime
853 endif
854 call clean_up_sound
856 # NOTE: Some sound can be playing! This will not be stopped.
858 # There is a very nasty delay before the first recording starts, do a dummy record
859 if not variableExists("recordingInitialized") and not sgc.useAlternativeRecorder
860 call basic_sound_recording 'samplingFrequency' 0.1
861 Remove
862 recordingInitialized = 1
863 endif
864 # Recording light
865 demo Paint circle... Red 5 95 2
866 demoShow()
868 # In Windows XP interaction between demoWaitForInput and Record Sound blocks drawing the feedback
869 # This code might be removed #
870 if windows and endsWith(build_SHA$, " XP")
871 # Display a pause window to flush the graphics buffer
872 beginPause ("DESTROY WINDOW ")
873 comment (" ")
874 endPause ("DESTROY WINDOW ", 1)
875 #call init_window
876 demo Paint circle... Red 5 95 2
877 demoShow()
878 endif
879 ##############################
880 call basic_sound_recording 'samplingFrequency' '.recordingTime'
882 demo Paint circle... White 5 95 2.5
883 call wipeArea 'wipeFeedbackArea$'
885 # Feedback on recording level
886 .extremum = Get absolute extremum... 0 0 None
887 .radius = 2 * .extremum
888 if .radius <= 0
889 .radius = 0.02
890 endif
891 .blue = 0
892 .green = 0
893 .red = 0
894 if .extremum >= 0.95
895 .red = 1
896 elsif .extremum >= 0.49
897 .green = 1
898 else
899 .green = .extremum / 0.5
900 endif
901 .color$ = "{'.red','.green','.blue'}"
902 demo Colour... '.color$'
903 demo Line width... 1
904 demo Draw circle... 5 95 '.radius'
905 # Reset
906 demoShow()
907 demo Colour... Black
908 demo Line width... 'defaultLineWidth'
909 # Process sound
910 Rename... Tmp
911 Resample... 10000 50
912 Rename... Pronunciation
913 recordedSound$ = selected$("Sound")
914 sgc.recordedSound = selected("Sound")
915 select Sound Tmp
916 Remove
917 select Sound 'recordedSound$'
918 sgc.recordedSound = selected("Sound")
920 # Cut out real sound from silences/noise
921 call sound_detection 'recordedSound$' 'soundMargin'
922 select Sound 'recordedSound$'
923 sgc.recordedSound = selected("Sound")
925 # Store audio if requested
926 if sgc.saveAudioOn and sgc.saveAudio$ <> ""
927 if sgc.savePerf$ <> "" and fileReadable(sgc.savePerf$)
928 .pinyin$ = ""
929 select sgc.currentWordlist
930 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
931 call readPinyin 'sgc.currentWord'
932 .pinyin$ = readPinyin.pinyin$
933 .outputName$ = "'sgc.saveAudio$'/'.pinyin$'.wav"
934 select sgc.recordedSound
935 Save as WAV file: .outputName$
936 endif
937 else
938 # The Audio directory disappeared
939 sgc.savePerf$ = ""
940 sgc.saveAudioOn = 0
941 sgc.saveAudio$ = ""
942 config.savePerf = 0
943 config.openPerf = 0
944 config.clearSummary = 0
945 config.audioName$ = ""
946 endif
947 endif
949 endproc
951 # Uses global variables!!!
952 procedure basic_sound_recording .samplingFrequency .recordingTime
953 # Use a different recorder program
954 if sgc.useAlternativeRecorder and fileReadable(sgc.recordCommandFile$)
955 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
956 .command$ < 'sgc.recordCommandFile$'
957 .command$ = replace$(.command$, "[']", """", 0)
958 .command$ = replace$(.command$, "'newline$'", " ", 0)
959 if unix or macintosh
960 if unix and .recordingTime < 1
961 .recordingTime = 1
962 endif
963 system_nocheck bash -c -- ''.command$' '.recordingTime''
964 elsif windows
965 system_nocheck call '.command$' '.recordingTime'
966 endif
967 .sound = Read from file: .scratchFile$
968 deleteFile(.scratchFile$)
969 else
970 .sound = nocheck noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 '.samplingFrequency' '.recordingTime'
971 if .sound = undefined
972 .sound = Create Sound: "Pronunciation", 0, .recordingTime, .samplingFrequency, "0"
973 endif
974 endif
976 # The recorded sound should now be the selected object!!!
977 select .sound
978 endproc
980 # Select real sound from recording
981 # Uses some global variable
982 procedure sound_detection .sound$ .margin
983 select Sound '.sound$'
984 .soundlength = Get total duration
985 .internalSilence = 2*.margin
987 # Silence and remove noise, DANGEROUS
988 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
989 Rename... Input'.sound$'
991 select TextGrid Input'.sound$'
992 .numberofIntervals = Get number of intervals... 1
993 if .numberofIntervals < 2
994 .numberofIntervals = 0
995 endif
997 # The code below will suppress noise, but also weak third tones
998 # This handles the problem that third tones can be realized with
999 # alternative cues, e.g, non-standard voice and very low levels
1000 #
1001 # Remove buzzing and other obnoxious sounds (if switched on)
1002 for .i from 1 to .numberofIntervals
1003 select TextGrid Input'.sound$'
1004 .value$ = Get label of interval... 1 '.i'
1005 .begintime = Get starting point... 1 '.i'
1006 .endtime = Get end point... 1 '.i'
1008 # Remove noise
1009 if .value$ = "silent"
1010 select Sound '.sound$'
1011 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
1012 endif
1013 endfor
1015 # Select target sound
1016 .maximumIntensity = -1
1017 .counter = 1
1018 for i from 1 to .numberofIntervals
1019 select TextGrid Input'.sound$'
1021 .value$ = Get label of interval... 1 'i'
1022 .begintime = Get starting point... 1 'i'
1023 .endtime = Get end point... 1 'i'
1025 if .value$ != "silent"
1026 if .begintime > .margin
1027 .begintime -= .margin
1028 else
1029 .begintime = 0
1030 endif
1031 if .endtime + .margin < .soundlength
1032 .endtime += .margin
1033 else
1034 .endtime = .soundlength
1035 endif
1037 select Sound '.sound$'
1038 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
1039 Rename... Tmp'.sound$'
1040 Subtract mean
1041 .newIntensity = Get intensity (dB)
1042 if .newIntensity > .maximumIntensity
1043 if .maximumIntensity > 0
1044 select Sound New'.sound$'
1045 Remove
1046 endif
1047 select Sound Tmp'.sound$'
1048 Rename... New'.sound$'
1049 .maximumIntensity = .newIntensity
1050 else
1051 select Sound Tmp'.sound$'
1052 Remove
1053 endif
1054 #
1055 endif
1056 endfor
1057 if .maximumIntensity > minimumIntensity
1058 select Sound '.sound$'
1059 Remove
1060 select Sound New'.sound$'
1061 Rename... '.sound$'
1062 elsif .maximumIntensity > -1
1063 select Sound New'.sound$'
1064 Remove
1065 endif
1066 select TextGrid Input'.sound$'
1067 Remove
1069 select Sound '.sound$'
1070 endproc
1072 procedure end_program
1073 call write_preferences ""
1074 demo Erase all
1075 select all
1076 Remove
1077 exit
1078 endproc
1080 ######################################################
1081 #
1082 # Configuration Page
1083 #
1084 ######################################################
1085 procedure config_page
1086 demo Erase all
1087 demoWindowTitle("Speak Good Chinese: Change settings")
1088 .label$ = ""
1089 call Draw_config_page
1091 goto GOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1093 while (.label$ <> "Return") and demoWaitForInput()
1094 .clickX = -1
1095 .clickY = -1
1096 .pressed$ = ""
1097 .label$ = ""
1098 if demoClicked()
1099 .clickX = demoX()
1100 .clickY = demoY()
1101 call buttonClicked 'config$' '.clickX' '.clickY'
1102 .label$ = buttonClicked.label$
1103 elsif demoKeyPressed()
1104 .pressed$ = demoKey$()
1105 call keyPressed 'config$' '.pressed$'
1106 .label$ = keyPressed.label$
1107 endif
1109 # You cannot select a text field
1110 if startsWith(.label$, "$")
1111 .label$ = ""
1112 endif
1114 # Do things
1115 if .label$ != ""
1116 # Handle push button in process_config
1117 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
1118 endif
1120 if .label$ = "Return"
1121 goto GOBACK
1122 endif
1123 endwhile
1125 # Go back
1126 label GOBACK
1127 call init_window
1128 endproc
1130 procedure Draw_config_page
1131 demo Erase all
1132 # Draw background
1133 if config.showBackground
1134 call draw_background Background
1135 endif
1136 # Draw buttons
1137 call Draw_all_buttons 'config$'
1138 call set_window_title 'config$'
1139 # Set correct buttons (alert)
1140 call setConfigMainPage
1141 endproc
1143 # Do what is asked
1144 procedure process_config .label$ .clickX .clickY .pressed$
1145 if .label$ <> "" and not startsWith(.label$,"!")
1146 .label$ = replace_regex$(.label$, "^[#]", "", 0)
1147 .label$ = replace$(.label$, "_", " ", 0)
1149 # Log activity
1150 'sgc2.logging$' call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1152 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1153 endif
1154 endproc
1156 ###############################################################
1157 #
1158 # Presenting help texts
1159 #
1160 ###############################################################
1162 # Process Help
1163 procedure help_loop .table$ .redrawProc$
1164 # General Help text
1165 call write_help_title '.table$'
1168 .label$ = ""
1169 call Draw_button '.table$' Help 2
1170 goto HELPGOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1172 .redrawScreen = 0
1173 while (.label$ <> "Help") and demoWaitForInput()
1174 .label$ = ""
1175 if demoClicked()
1176 .clickX = demoX()
1177 .clickY = demoY()
1178 call buttonClicked '.table$' '.clickX' '.clickY'
1179 .label$ = buttonClicked.label$
1180 elsif demoKeyPressed()
1181 .pressed$ = demoKey$()
1182 call keyPressed '.table$' '.pressed$'
1183 .label$ = keyPressed.label$
1184 endif
1186 if .label$ != "" and .label$ <> "Help"
1187 # Redraw screen
1188 if .redrawScreen
1189 demo Erase all
1190 call '.redrawProc$'
1191 else
1192 .redrawScreen = 1
1193 endif
1194 call Draw_button '.table$' Help 2
1195 call write_help_title '.table$'
1197 # Handle push button in process_config
1198 call write_help_text '.table$' '.label$'
1200 # Log activity
1201 'sgc2.logging$' demo Erase all
1202 'sgc2.logging$' call '.redrawProc$'
1203 'sgc2.logging$' call write_help_title '.table$'
1204 'sgc2.logging$' call write_help_text '.table$' '.label$'
1205 endif
1207 endwhile
1209 label HELPGOBACK
1210 # Reset button
1211 call Draw_button '.table$' Help 0
1212 demo Erase all
1213 call '.redrawProc$'
1214 endproc
1216 # Write help text
1217 procedure write_help_text .table$ .label$
1218 call findLabel '.table$' '.label$'
1219 .row = findLabel.row
1220 select Table '.table$'
1221 # Get text
1222 if .row <= 0
1223 call findLabel '.table$' Help
1224 .row = findLabel.row
1225 select Table '.table$'
1226 endif
1227 .helpText$ = Get value... '.row' Helptext
1228 .helpKey$ = Get value... '.row' Key
1229 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1230 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1231 if index_regex(.helpKey$, "\S")
1232 .helpText$ = .helpText$+" ("+.helpKey$+")"
1233 endif
1234 # Get button values
1235 .leftX = Get value... '.row' LeftX
1236 .rightX = Get value... '.row' RightX
1237 .lowY = Get value... '.row' LowY
1238 .highY = Get value... '.row' HighY
1240 # PopUp dimensions
1241 .currentHelpFontSize = defaultFontSize
1242 call set_font_size '.currentHelpFontSize'
1243 .helpTextSize = demo Text width (wc)... '.helpText$'
1244 .helpTextSize += 4
1245 if .leftX > 50
1246 .htXleft = 20
1247 .htXright = .htXleft + .helpTextSize + 5
1248 .xstart = .leftX
1249 else
1250 .htXright = 80
1251 .htXleft = .htXright - .helpTextSize - 5
1252 .xstart = .rightX
1253 endif
1254 if .lowY > 50
1255 .htYlow = 40
1256 .htYhigh = .htYlow + 7
1257 .ystart = .lowY
1258 .yend = .htYhigh
1259 else
1260 .htYhigh = 60
1261 .htYlow = .htYhigh - 7
1262 .ystart = .highY
1263 .yend = .htYlow
1264 endif
1266 # Adapt font size to horizontal dimensions
1267 .maxWidth = 90
1268 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1269 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1270 if .htXleft < 0 or .htXright > 100
1271 .htXleft = 0
1272 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1273 endif
1274 call set_font_size '.currentHelpFontSize'
1276 # Adapt vertical dimensions to font height
1277 call points_to_wc '.currentHelpFontSize'
1278 .lineHeight = points_to_wc.wc
1279 if .lineHeight > .htYhigh - .htYlow - 4
1280 .htYhigh = .htYlow + .lineHeight + 4
1281 endif
1283 # Determine arrow endpoints
1284 .xend = .htXleft
1285 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1286 .xend = .htXright
1287 endif
1288 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1289 .xend = (.htXleft+.htXright)/2
1290 endif
1292 .xtext = .htXleft + 2
1293 .ytext = .htYlow + 1
1295 # Draw pop-up
1296 .mm2wc = demo Horizontal mm to wc... 1
1297 .lineWidth = 2/.mm2wc
1298 demo Line width... '.lineWidth'
1299 demo Arrow size... '.lineWidth'
1300 demo Colour... 'sgc2.popUp_bordercolor$'
1301 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1302 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1303 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1304 demo Line width... 'defaultLineWidth'
1305 demo Arrow size... 1
1306 demo Black
1307 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1308 demoShow()
1309 call set_font_size 'defaultFontSize'
1311 endproc
1313 procedure write_help_title .table$
1314 # Set help text title
1315 # General Help text
1316 call findLabel '.table$' Help
1317 .row = findLabel.row
1318 select Table '.table$'
1319 .helpTitle$ = Get value... '.row' Helptext
1320 .helpKey$ = Get value... '.row' Key
1321 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1322 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1323 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1325 call reset_viewport
1326 .helpTitleFontSize = 14
1327 # Adapt size of button to length of text
1328 .maxWidth = 80
1329 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1330 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1331 call set_font_size '.helpTitleFontSize'
1332 .helpTop = 100
1334 demo Select inner viewport... 0 100 0 100
1335 demo Axes... 0 100 0 100
1336 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1337 call set_font_size 'defaultFontSize'
1338 call reset_viewport
1339 endproc
1341 ###############################################################
1342 #
1343 # Miscelaneous procedures
1344 #
1345 ###############################################################
1346 procedure printPageToPrinter
1347 call print_window
1348 demo Print... 'printerName$' 'printerPresets$'
1349 call init_window
1350 endproc
1352 procedure points_to_wc .points
1353 .mm = .points * 0.3527777778
1354 .wc = demo Vertical mm to wc... '.mm'
1355 endproc
1357 procedure reset_viewport
1358 .low = viewportMargin
1359 .high = 100 - viewportMargin
1360 demo Select inner viewport... '.low' '.high' '.low' '.high'
1361 demo Axes... 0 100 0 100
1362 endproc
1364 procedure set_font_size .fontSize
1365 call reset_viewport
1366 demo Font size... '.fontSize'
1367 call reset_viewport
1368 endproc
1370 procedure wipeArea .areaCommand$
1371 call reset_viewport
1372 '.areaCommand$'
1373 endproc
1375 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1376 demo '.font$'
1377 call set_font_size '.currentFontSize'
1378 .textWidth = demo Text width (wc)... '.text$'
1379 while .textWidth > .maxWidth and .currentFontSize > 2
1380 .currentFontSize -= 0.5
1381 call set_font_size '.currentFontSize'
1382 .textWidth = demo Text width (wc)... '.text$'
1383 endwhile
1384 .diff = .textWidth - .maxWidth
1385 .newFontSize = .currentFontSize
1386 demo 'defaultFont$'
1387 endproc
1389 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1390 demo '.font$'
1391 .radians = .rotation/360 * 2 * pi
1392 .horWC = demo Horizontal mm to wc... 10.0
1393 .verWC = demo Vertical mm to wc... 10.0
1394 if .horWC > 0
1395 .verCoeff = .verWC / .horWC
1396 else
1397 .verCoeff = 1
1398 endif
1399 call set_font_size '.currentFontSize'
1400 .textLength = demo Text width (wc)... '.text$'
1401 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1402 .currentFontSize -= 0.5
1403 call set_font_size '.currentFontSize'
1404 .textLength = demo Text width (wc)... '.text$'
1405 endwhile
1406 .diff = .textLength - .maxHeight
1407 .newFontSize = .currentFontSize
1408 demo 'defaultFont$'
1409 endproc
1411 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1412 demo '.font$'
1413 call points_to_wc '.currentFontSize'
1414 .lineHeight = points_to_wc.wc
1415 while .lineHeight > .maxHeight and .currentFontSize > 2
1416 .currentFontSize -= 0.5
1417 call points_to_wc '.currentFontSize'
1418 .lineHeight = points_to_wc.wc
1419 endwhile
1420 .diff = .lineHeight - .maxHeight
1421 .newFontSize = .currentFontSize
1422 demo 'defaultFont$'
1423 endproc
1425 # Load a table with button info etc.
1426 # Load local tables if present. Else load
1427 # build-in scripted tables
1428 procedure loadTable .tableName$
1429 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1430 # Search for the table in local, preference, and global directories
1431 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1432 .table = Read from file... 'localTableDir$'/'.tableName$'.Table
1433 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1434 .table = Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1435 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1436 .table = Read from file... 'globaltablelists$'/'.tableName$'.Table
1437 # Load them from script
1438 elsif variableExists("procCreate'.tableVariableName$'$")
1439 call Create'.tableVariableName$'
1440 Rename: .tableName$
1441 .table = selected("Table")
1442 else
1443 call emergency_table_exit '.tableName$' cannot be found
1444 endif
1446 # Check whether this is a real table
1447 selectObject: .table
1448 .fullName$ = selected$ ()
1449 .type$ = extractWord$(.fullName$, "")
1450 if .type$ <> "Table"
1451 Remove
1452 .table = -1
1453 endif
1455 if .table <= 0
1456 call emergency_table_exit '.tableFileName$' corrupted or cannot be found
1457 endif
1458 endproc
1460 procedure testLoadTable .tableName$
1461 .table = 0
1462 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1463 # Search for the table in local, preference, and global directories
1464 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1465 .table = 1
1466 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1467 .table = 2
1468 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1469 .table = 3
1470 # Load them from script
1471 elsif variableExists("procCreate'.tableVariableName$'$")
1472 .table = 4
1473 else
1474 .table = 0
1475 endif
1476 endproc
1478 procedure checkTable .tableName$
1479 .available = 0
1480 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1481 .available = 1
1482 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1483 .available = 1
1484 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1485 .available = 1
1486 # Load them from script
1487 elsif variableExists("procCreate'.tableName$'$")
1488 .available = 1
1489 else
1490 .available = 0
1491 endif
1492 endproc
1494 # Create a pop-up window with text from a Text Table
1495 procedure write_text_table .table$
1496 .xleft = 10
1497 .xright = 90
1498 .ylow = 20
1499 .yhigh = 85
1500 .lineHeight = 2.5
1502 # Get table with text and longest line
1503 .numLines = 0
1504 call testLoadTable '.table$'
1505 if testLoadTable.table > 0
1506 call loadTable '.table$'
1507 .instructionText = selected()
1508 .numLines = Get number of rows
1509 else
1510 goto ESCAPEwrite_text_table
1511 endif
1512 .instructionFontSize = 14
1513 .referenceText$ = ""
1514 .maxlenght = 0
1515 .maxLine = 0
1516 .maxFontSize = 0
1517 .maxWidth = 0
1518 for .l to .numLines
1519 select '.instructionText'
1520 .currentText$ = Get value... '.l' text
1521 # Expand variables, eg, 'praatVersion$'
1522 call expand_praat_variables '.currentText$'
1523 .currentText$ = expand_praat_variables.text$
1525 .font$ = Get value... '.l' font
1526 .fontSize = Get value... '.l' size
1527 call set_font_size '.fontSize'
1528 .textWidth = demo Text width (wc)... '.currentText$'
1529 if .fontSize > .maxFontSize
1530 .maxFontSize = .fontSize
1531 endif
1532 if .textWidth > .maxWidth
1533 .maxWidth = .textWidth
1534 .instructionFontSize = .fontSize
1535 .maxLine = .l
1536 endif
1537 endfor
1538 select '.instructionText'
1539 .referenceText$ = Get value... '.maxLine' text
1540 .maxLineFont$ = Get value... '.maxLine' font
1541 .instructionFontSize = Get value... '.maxLine' size
1542 call set_font_size '.maxFontSize'
1544 # Adapt size of button to length of text
1545 .maxWidth = (.xright - .xleft) - 4
1546 .origFontSize = .instructionFontSize
1547 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1548 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1549 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1550 if adjustFontSizeOnWidth.diff > 0
1551 .xright += adjustFontSizeOnWidth.diff/4
1552 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1553 endif
1554 call set_font_size '.instructionFontSize'
1555 .fontSizeFactor = .instructionFontSize / .origFontSize
1557 .numRows = Get number of rows
1558 # Calculate length from number of lines.
1559 .dy = .lineHeight
1560 .midY = .yhigh - (.yhigh - .ylow)/2
1561 .yhigh = .midY + (.numRows+1) * .dy / 2
1562 .ylow = .yhigh - (.numRows+1) * .dy
1563 .textleft = .xleft + 2
1565 demo Line width... 8
1566 demo Colour... 'sgc2.popUp_bordercolor$'
1567 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1568 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1569 demo Line width... 'defaultLineWidth'
1570 demo Black
1571 .ytext = .yhigh - 2 - .dy
1572 for .i to .numRows
1573 select '.instructionText'
1574 .font$ = Get value... '.i' font
1575 .fontSize = Get value... '.i' size
1576 .font$ = extractWord$(.font$, "")
1577 # Scale font
1578 .fontSize = floor(.fontSize*.fontSizeFactor)
1579 if .fontSize < 4
1580 .fontSize = 4
1581 endif
1582 .line$ = Get value... '.i' text
1583 # Expand variables, eg, 'praatVersion$'
1584 call expand_praat_variables '.line$'
1585 .line$ = expand_praat_variables.text$
1587 # Display text
1588 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1589 .ytext -= .dy
1590 endfor
1591 demoShow()
1592 call set_font_size 'defaultFontSize'
1594 select '.instructionText'
1595 Remove
1597 label ESCAPEwrite_text_table
1598 endproc
1601 # Create a pop-up window with text from an existing Table object
1602 procedure write_tabbed_table .table$ .labelTextTable$
1603 .xleft = 0
1604 .xright = 100
1605 .ylow = 20
1606 .yhigh = 85
1607 .lineHeight = 2.5
1609 # Get table with text and longest line
1610 call testLoadTable '.table$'
1611 if testLoadTable.table <= 0
1612 call loadTable '.labelTextTable$'
1613 .labelText$ = selected$("Table")
1614 endif
1616 select Table '.table$'
1617 .tabbedText = selected()
1618 .numLines = Get number of rows
1619 .numCols = Get number of columns
1620 .font$ = defaultFont$
1621 .fontSize = defaultFontSize
1622 # Standard width
1623 .widthCanvas = .xright - .xleft
1624 .dx = (.widthCanvas - 4) / (.numCols)
1626 # Get longest entry
1627 demo '.font$'
1628 call set_font_size '.fontSize'
1629 .maxWidth = 0
1630 for .i from 0 to .numLines
1631 .xtext = .xleft + .dx / 2
1632 for .j to .numCols
1633 select '.tabbedText'
1634 .currentLabel$ = Get column label... '.j'
1635 if .i > 0
1636 .line$ = Get value... '.i' '.currentLabel$'
1637 else
1638 .line$ = .currentLabel$
1639 select Table '.labelText$'
1640 call findLabel '.labelText$' '.line$'
1641 select Table '.labelText$'
1642 .line$ = Get value... 'findLabel.row' Text
1643 endif
1644 # Expand variables, eg, 'praatVersion$'
1645 call expand_praat_variables '.line$'
1646 .line$ = expand_praat_variables.text$
1647 .textWidth = demo Text width (wc)... '.line$'
1648 if .textWidth > .maxWidth
1649 .maxWidth = .textWidth
1650 endif
1651 endfor
1652 endfor
1653 if .dx > 1.2 * .maxWidth
1654 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1655 .xleft = 50 - .widthCanvas / 2
1656 .xright = 50 + .widthCanvas / 2
1657 .dx = (.widthCanvas - 4) / (.numCols)
1658 else
1659 .maxWidth = .dx - 1
1660 endif
1662 # Calculate length from number of lines.
1663 .dy = .lineHeight + 0.5
1664 .midY = .yhigh - (.yhigh - .ylow)/2
1665 .yhigh = .midY + (.numLines+2) * .dy / 2
1666 .ylow = .yhigh - (.numLines+2) * .dy
1667 .textleft = .xleft + 2
1669 demo Line width... 8
1670 demo Colour... 'sgc2.popUp_bordercolor$'
1671 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1672 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1673 demo Line width... 'defaultLineWidth'
1674 demo Black
1675 .ytext = .yhigh - 2 - .dy
1676 # First the column names, then the items
1677 for .i from 0 to .numLines
1678 .xtext = .textleft + .dx / 2
1679 for .j to .numCols
1680 select '.tabbedText'
1681 .currentLabel$ = Get column label... '.j'
1682 if .i > 0
1683 .line$ = Get value... '.i' '.currentLabel$'
1684 else
1685 .line$ = .currentLabel$
1686 select Table '.labelText$'
1687 call findLabel '.labelText$' '.line$'
1688 select Table '.labelText$'
1689 .line$ = Get value... 'findLabel.row' Text
1690 endif
1691 # Expand variables, eg, 'praatVersion$'
1692 call expand_praat_variables '.line$'
1693 .line$ = expand_praat_variables.text$
1694 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1695 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1697 # Display text
1698 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1699 .xtext += .dx
1700 endfor
1701 .ytext -= .dy
1702 endfor
1703 demoShow()
1704 call set_font_size 'defaultFontSize'
1705 select Table '.labelText$'
1706 Remove
1708 label ESCAPEwrite_tabbed_table
1709 endproc
1711 # Create a pop-up window with a given text
1712 procedure write_text_popup .font$ .size .text$
1713 .xleft = 10
1714 .xright = 90
1715 .ylow = 20
1716 .yhigh = 85
1717 .lineHeight = 3
1719 # Adapt size of button to length of text
1720 .maxWidth = (.xright - .xleft) - 4
1721 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1722 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1723 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1724 if adjustFontSizeOnWidth.diff > 0
1725 .xright += adjustFontSizeOnWidth.diff/4
1726 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1727 else
1728 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1729 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1730 endif
1732 .numRows = 1
1733 # Calculate length from number of lines.
1734 .dy = .lineHeight
1735 .midY = .yhigh - (.yhigh - .ylow)/2
1736 .yhigh = .midY + (.numRows+1) * .dy / 2
1737 .ylow = .yhigh - (.numRows+1) * .dy
1738 .textleft = .xleft + 2
1739 .xmid = (.textleft + .xright - 2)/2
1741 demo Line width... 8
1742 demo Colour... 'sgc2.popUp_bordercolor$'
1743 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1744 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1745 demo Line width... 'defaultLineWidth'
1746 demo Black
1747 .ytext = .yhigh - 2 - .dy
1748 # Write text
1749 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1751 demoShow()
1752 demo 'defaultFont$'
1753 call set_font_size 'defaultFontSize'
1754 endproc
1756 # Write the background from a Text Table
1757 procedure draw_background .table$
1758 .xleft = 0
1759 .xright = 100
1760 .ylow = 0
1761 .yhigh = 100
1762 .lineHeight = 5
1763 .defaultColour$ = "{0.9,0.9,0.9}"
1764 .defaultAlign$ = "centre"
1766 # Get table with text and longest line
1767 call loadTable '.table$'
1768 .backgroundText = selected()
1769 .numLines = Get number of rows
1770 .backgroundFontSize = 28
1771 .referenceText$ = ""
1772 .maxlenght = 0
1773 .maxLine = 0
1774 .maxFontSize = 0
1775 .maxWidth = 0
1776 .textLines = 0
1777 for .l to .numLines
1778 select '.backgroundText'
1779 .currentText$ = Get value... '.l' text
1780 # Expand variables, eg, 'praatVersion$'
1781 call expand_praat_variables '.currentText$'
1782 .currentText$ = expand_praat_variables.text$
1784 .font$ = Get value... '.l' font
1785 .fontSize = Get value... '.l' size
1786 if .fontSize > .maxFontSize
1787 .maxFontSize = .fontSize
1788 endif
1789 if not startsWith(.font$, "!")
1790 call set_font_size '.fontSize'
1791 .textWidth = demo Text width (wc)... '.currentText$'
1792 if .textWidth > .maxWidth
1793 .maxWidth = .textWidth
1794 .backgroundFontSize = .fontSize
1795 .maxLine = .l
1796 endif
1798 .textLines += 1
1799 endif
1800 endfor
1801 if .maxLine > 0
1802 select '.backgroundText'
1803 .referenceText$ = Get value... '.maxLine' text
1804 .maxLineFont$ = Get value... '.maxLine' font
1805 .backgroundFontSize = Get value... '.maxLine' size
1806 .backgroundFontColour$ = Get value... '.maxLine' colour
1807 call set_font_size '.maxFontSize'
1808 else
1809 .maxFontSize = .backgroundFontSize
1810 endif
1812 # Adapt size of button to length of text
1813 .maxWidth = (.xright - .xleft) - 4
1814 .origFontSize = .backgroundFontSize
1815 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1816 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1817 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1818 call set_font_size '.backgroundFontSize'
1820 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1821 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1822 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1823 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1824 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1825 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1826 endif
1828 .numRows = Get number of rows
1829 # Calculate length from number of lines.
1830 .dy = .lineHeight
1831 .midY = .yhigh - (.yhigh - .ylow)/2
1832 .yhigh = .midY + (.textLines+1) * .dy / 2
1833 .ylow = .yhigh - (.textLines+1) * .dy
1834 .textleft = .xleft + 2
1835 .textright = .xright - 2
1836 .textmid = (.xright - .xleft)/2
1838 demo Black
1839 .ytext = .yhigh - 2 - .dy
1840 for .i to .numRows
1841 select '.backgroundText'
1842 .font$ = Get value... '.i' font
1843 .fontSize = Get value... '.i' size
1844 .fontColour$ = Get value... '.i' colour
1845 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1846 .fontAlign$ = Get value... '.i' align
1847 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1848 .line$ = Get value... '.i' text
1849 # Expand variables, eg, 'praatVersion$'
1850 call expand_praat_variables '.line$'
1851 .line$ = expand_praat_variables.text$
1853 # Scale font
1854 .fontSize = floor(.fontSize*.fontSizeFactor)
1855 if not startsWith(.font$, "!")
1856 .font$ = extractWord$(.font$, "")
1858 if .fontAlign$ = "centre"
1859 .xtext = .textmid
1860 elsif .fontAlign$ = "right"
1861 .xtext = .textright
1862 else
1863 .xtext = .textleft
1864 endif
1865 if .fontSize < 4
1866 .fontSize = 4
1867 endif
1868 # Clean up text
1869 demo Colour... '.fontColour$'
1870 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1871 .ytext -= .dy
1872 elsif .font$ = "!demo command"
1873 demo Colour... '.fontColour$'
1874 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1875 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1876 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1877 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1878 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1879 while index(.line$, "[[")
1880 .nextBracketOpen = index(.line$, "[[")
1881 .nextBracketOpen += 2
1882 .nextBracketClose = index(.line$, "]]")
1883 .bracketLength = .nextBracketClose - .nextBracketOpen
1884 .result$ = ""
1885 if .bracketLength > 0
1886 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1887 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1888 if length(.expression$) > 0
1889 # Test expression for security, only allow explicitely defined functions
1890 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1891 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1892 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1893 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1894 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1895 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1896 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1897 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1898 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1899 if .testExpression$ = ""
1900 .calc = '.expression$'
1901 .result$ = "'.calc'"
1902 endif
1903 endif
1904 endif
1906 # Replace expression by result
1907 .lastLeft = .nextBracketOpen - 3
1908 .newLine$ = left$(.line$, .lastLeft)
1909 .newLine$ = .newLine$ + .result$
1910 .numCopy = length(.line$) - .nextBracketClose - 1
1911 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1912 .line$ = .newLine$
1913 endwhile
1914 demo '.line$'
1915 endif
1916 endfor
1917 demo Black
1918 demoShow()
1919 call set_font_size 'defaultFontSize'
1921 select '.backgroundText'
1922 Remove
1923 endproc
1925 procedure convert_praat_to_utf8 .text$
1926 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1927 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1928 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1929 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1930 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1931 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1932 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1933 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1934 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1935 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1936 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1937 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1938 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1939 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1940 endproc
1942 procedure convert_praat_to_latin1 .text$
1943 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1944 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1945 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1946 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1947 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1948 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1949 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1950 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1951 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1952 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1953 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1954 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1955 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1956 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1957 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1958 endproc
1960 # Expand 'variable$' into the value of variable$.
1961 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1962 # Single quotes can be protected by \'
1963 procedure expand_praat_variables .text$
1964 if index(.text$, "'")
1965 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1966 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1967 .tempText$ = """"+.tempText$+""""
1968 # Check whether all the variables actually exist. Ignore any variable that does not exist
1969 .checkVars$ = .tempText$
1970 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1971 .start = index(.checkVars$, "+")
1972 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1973 .end = index(.checkVars$, "+")
1974 if .end
1975 .variable$ = left$(.checkVars$, .end - 1)
1976 if not variableExists(.variable$)
1977 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1978 endif
1979 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1980 else
1981 .checkVars$ = ""
1982 endif
1983 endwhile
1984 .text$ = '.tempText$'
1985 endif
1986 endproc
1988 # Get a time stamp in normalized format
1989 procedure getTimeStamp
1990 .currentDateTime$ = date$()
1991 .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)
1992 endproc
1994 # A table error, can be insiduously caused by an outdate preferences file!
1995 procedure emergency_table_exit .message$
1996 # If you come here as a user, your preferences file is borked
1997 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
1998 deleteFile(preferencesAppFile$)
1999 endif
2000 # Put out message
2001 call get_feedback_text 'config.language$' Cancel
2002 call convert_praat_to_latin1 'get_feedback_text.text$'
2003 .cancelText$ = convert_praat_to_latin1.text$
2004 beginPause: "Fatal Error"
2005 comment: .message$
2006 endPause: .cancelText$, 1
2007 exit '.message$'
2008 endproc
2010 # Remove previous files from system
2011 procedure clean_up_sound
2012 if recordedSound$ = ""
2013 sgc.recordedSound = 0
2014 endif
2015 if sgc.recordedSound > 0
2016 select sgc.recordedSound
2017 Remove
2018 recordedSound$ = ""
2019 sgc.recordedSound = 0
2020 endif
2021 if te.recordedPitch > 0
2022 select te.recordedPitch
2023 Remove
2024 te.recordedPitch = 0
2025 endif
2026 if sgc.alignedTextGrid > 0
2027 select sgc.alignedTextGrid
2028 Remove
2029 sgc.alignedTextGrid = -1
2030 endif
2031 endproc
2033 # Safely read a table
2034 procedure readTable .filename$
2035 .tableID = -1
2036 if .filename$ <> "" and fileReadable(.filename$) and index_regex(.filename$, "(?i\.(tsv|table|csv))$") > 0
2037 if index_regex(.filename$, "(?i\.(csv))$") > 0
2038 .tableID = Read Table from comma-separated file: .filename$
2039 elsif index_regex(.filename$, "(?i\.(tsv))$") > 0
2040 .tableID = nocheck Read Table from tab-separated file: .filename$
2041 else
2042 .tableID = nocheck Read from file... '.filename$'
2043 endif
2044 if .tableID = undefined or .tableID <= 0
2045 .tableID = -1
2046 else
2047 .fullName$ = selected$ ()
2048 .type$ = extractWord$(.fullName$, "")
2049 if .type$ <> "Table"
2050 Remove
2051 .tableID = -1
2052 endif
2053 endif
2054 endif
2055 endproc
2057 # Read feedback table and get keyed text
2058 procedure get_feedback_text .language$ .key$
2059 if not endsWith(feedbackTableName$, "_'.language$'")
2060 if feedbackTableName$ <> ""
2061 select Table 'feedbackTableName$'
2062 Remove
2063 endif
2064 call testLoadTable 'feedbackTablePrefix$'_'.language$'
2065 if testLoadTable.table > 0
2066 call loadTable 'feedbackTablePrefix$'_'.language$'
2067 else
2068 call loadTable 'feedbackTablePrefix$'_EN
2069 endif
2070 feedbackTableName$ = selected$("Table")
2071 endif
2072 call findKey 'feedbackTableName$' '.key$'
2073 .row = findKey.row
2074 select Table 'feedbackTableName$'
2075 .text$ = Get value... '.row' Text
2076 # Expand variables, eg, 'praatVersion$'
2077 call expand_praat_variables '.text$'
2078 .text$ = expand_praat_variables.text$
2079 endproc
2082 # Read evaluation table and get keyed text. Only praat converted Text
2083 procedure get_evaluation_text .language$ .key$
2084 if not endsWith(evaluationTableName$, "_'.language$'")
2085 if evaluationTableName$ <> ""
2086 select Table 'evaluationTableName$'
2087 Remove
2088 endif
2089 call testLoadTable 'evaluationTablePrefix$'_'.language$'
2090 if testLoadTable.table > 0
2091 call loadTable 'evaluationTablePrefix$'_'.language$'
2092 else
2093 call loadTable 'evaluationTablePrefix$'_EN
2094 endif
2095 evaluationTableName$ = selected$("Table")
2096 endif
2097 call findLabel 'evaluationTableName$' '.key$'
2098 .row = findLabel.row
2099 select Table 'evaluationTableName$'
2100 .text$ = Get value... '.row' Text
2101 # Expand variables, eg, 'praatVersion$'
2102 call expand_praat_variables '.text$'
2103 .rawtext$ = expand_praat_variables.text$
2104 call convert_praat_to_latin1 '.rawtext$'
2105 .text$ = convert_praat_to_latin1.text$
2106 endproc
2108 # Read all the relevant evaluation labels and put them in "eval.<label>$" variables
2109 procedure get_evaluation_table_labels .language$
2110 call get_evaluation_text '.language$' Performance
2111 eval.performance$ = get_evaluation_text.text$
2112 call get_evaluation_text '.language$' Pinyin
2113 eval.pinyin$ = get_evaluation_text.text$
2114 call get_evaluation_text '.language$' Correct
2115 eval.correct$ = get_evaluation_text.text$
2116 call get_evaluation_text '.language$' Wrong
2117 eval.wrong$ = get_evaluation_text.text$
2118 call get_evaluation_text '.language$' Total
2119 eval.total$ = get_evaluation_text.text$
2120 call get_evaluation_text '.language$' High
2121 eval.high$ = get_evaluation_text.text$
2122 call get_evaluation_text '.language$' Low
2123 eval.low$ = get_evaluation_text.text$
2124 call get_evaluation_text '.language$' Wide
2125 eval.wide$ = get_evaluation_text.text$
2126 call get_evaluation_text '.language$' Narrow
2127 eval.narrow$ = get_evaluation_text.text$
2128 call get_evaluation_text '.language$' Unknown
2129 eval.unknown$ = get_evaluation_text.text$
2130 call get_evaluation_text '.language$' Commented
2131 eval.commented$ = get_evaluation_text.text$
2132 call get_evaluation_text '.language$' Level
2133 eval.level$ = get_evaluation_text.text$
2134 call get_evaluation_text '.language$' Time
2135 eval.time$ = get_evaluation_text.text$
2137 endproc
2139 # log activity
2140 procedure saveLogOfActivity .command$
2141 # Do not log in binary!
2142 if build_SHA$ = "-"
2143 createDirectory(preferencesLogDir$)
2144 appendFileLine: "'preferencesLogDir$'/'logtimeStamp$'.log", .command$
2145 endif
2146 endproc
2148 # Replay a log file with commands sgc.replaySleep inserts a pause
2149 procedure replaySGC2LogFunction
2150 if not variableExists("sgc.replaySleep")
2151 sgc.replaySleep = -1
2152 endif
2153 # Do not replay in binary!
2154 if build_SHA$ = "-"
2155 # Ask for the input file
2156 .filename$ = chooseReadFile$ ("Select file to replay")
2157 if .filename$ <> "" and fileReadable(.filename$)
2158 .replayFile = Read Strings from raw text file: .filename$
2159 if .replayFile <> undefined
2160 # Pre-pause
2161 if sgc.replaySleep > 0
2162 call basic_sound_recording 'samplingFrequency' 'sgc.replaySleep'
2163 Remove
2164 endif
2165 select .replayFile
2166 .numStrings = Get number of strings
2167 for .l to .numStrings
2168 select .replayFile
2169 .line$ = Get string: .l
2170 if index_regex(.line$, "process(MainPage|Config)(Help|Config|Return|Quit)")
2171 if index(.line$, "processMainPageConfig")
2172 .line$ = "call Draw_config_page"
2173 elsif index_regex(.line$, "processConfigReturn")
2174 .line$ = "call init_window"
2175 elsif index_regex(.line$, "processMainPageHelp")
2176 .line$ = "call init_window"
2177 elsif index_regex(.line$, "processConfigHelp")
2178 .line$ = "call Draw_config_page"
2179 else
2180 .line$ = "# " + .line$
2181 endif
2182 endif
2183 if index_regex(.line$, "[a-zA-Z]") > 0 and index_regex(.line$, "\s*#") <= 0
2184 # Execute
2185 '.line$'
2187 # Pause
2188 if sgc.replaySleep > 0
2189 call basic_sound_recording 'samplingFrequency' 'sgc.replaySleep'
2190 Remove
2191 endif
2192 endif
2193 endfor
2194 endif
2195 endif
2196 endif
2197 endproc