| blob | 8945b0706310da595c2ce2d619544eb4682b951a |
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 .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
422 if .newText$ = ""
423 .newText$ = .buttonText$
424 endif
425 # Variable text field, read corresponding variable
426 if index(.newText$, "$$$")
427 .fieldName$ = replace_regex$(.label$, "^[!$#]", "", 0)
428 .fieldName$ = replace_regex$(.fieldName$, "^(.)", "\l\1", 0)
429 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
430 .newText$ = replace$(.newText$, "$$$", '.varPrefix$'.'.fieldName$'$, 0)
431 endif
432 if .push = 1 or .push = -1
433 demo Grey
434 if .buttonColor$ = "Red"
435 .buttonColor$ = "Pink"
436 elsif .buttonColor$ = "Blue"
437 .buttonColor$ = "{0.5,0.5,1}"
438 else
439 .buttonColor$ = "Grey"
440 endif
441 elsif .push >= 2
442 .buttonColor$ = "Maroon"
443 else
444 demo Colour... Black
445 endif
447 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
448 call set_font_size '.buttonFontSize'
449 demo Colour... '.buttonColor$'
450 if .rotation = 0
451 .anchorY = .lowY
452 .verticalAlignment$ = "Bottom"
453 else
454 .anchorY = .lowY + 0.5*(.highY-.lowY)
455 .verticalAlignment$ = "Half"
456 endif
457 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
458 demoShow()
460 # Reset
461 call set_font_size 'defaultFontSize'
462 demo Black
463 demo Line width... 'defaultLineWidth'
465 label NOBUTTON
466 endproc
468 procedure set_window_title .table$ .addedText$
469 select Table '.table$'
470 .row = Search column... Label !WindowTitle
471 if .row < 1
472 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
473 endif
474 .windowText$ = Get value... '.row' Text
475 call convert_praat_to_latin1 '.windowText$'
476 .windowText$ = convert_praat_to_latin1.text$
478 if index(.windowText$, "$$$")
479 .displayWindowText$ = replace$(.windowText$, "$$$", .addedText$, 0)
480 else
481 .displayWindowText$ = .windowText$ + .addedText$
482 endif
484 demoWindowTitle(.displayWindowText$ )
485 endproc
487 # Handle language setting
488 procedure processLanguageCodes .table$ .label$
489 .table$ = "Config"
490 call Draw_button 'config$' Language_'config.language$' 0
491 call Draw_button 'config$' '.label$' 2
492 # Someone might have to use more than 2 chars for the language code
493 .numChars = length(.label$) - length("Language_")
494 .lang$ = right$(.label$, .numChars)
495 # Load new tables
496 call set_language '.lang$'
497 endproc
499 # Set the language
500 procedure set_language .lang$
501 .redraw_config = 0
502 # Remove old tables
503 if buttons$ <> ""
504 select Table 'buttons$'
505 Remove
506 .redraw_config = 1
507 endif
508 if config$ <> ""
509 select Table 'config$'
510 Remove
511 .redraw_config = 1
512 endif
514 # See whether there is a custom language
515 sgc.customLanguage$ = ""
516 .langList = nocheck Create Strings as file list: "CustomLanguages", preferencesTableDir$+"/Config_*.Table"
517 # NOTE: The list might not exist!!!
518 if .langList = undefined
519 .numLanguages = -1
520 else
521 .numLanguages = Get number of strings
522 endif
523 if .numLanguages <= 0
524 if not .langList = undefined
525 Remove
526 endif
527 .langList = nocheck Create Strings as file list: "CustomLanguages", globaltablelists$+"/Config_*.Table"
528 if .langList = undefined
529 .numLanguages = -1
530 else
531 .numLanguages = Get number of strings
532 endif
533 endif
534 if .numLanguages > 0
535 .configTable$ = Get string: 1
536 .startChar = rindex(.configTable$, "_")
537 sgc.customLanguage$ = right$(.configTable$, length(.configTable$) - .startChar)
538 sgc.customLanguage$ = left$(sgc.customLanguage$, index(sgc.customLanguage$, ".") -1)
539 endif
540 if not .langList = undefined
541 select .langList
542 Remove
543 endif
545 # Set language
546 call checkTable 'configTableName$'_'.lang$'
547 if checkTable.available
548 config.language$ = .lang$
549 else
550 config.language$ = "EN"
551 endif
553 if config.language$ = "JA"
554 CJK font style preferences: "Japanese"
555 else
556 CJK font style preferences: "Chinese"
557 endif
559 # Load buttons tables
560 call loadTable 'buttonsTableName$'
561 buttons$ = selected$("Table")
562 Append column... Text
563 Append column... Key
564 Append column... Helptext
565 .numLabels = Get number of rows
566 call testLoadTable 'buttonsTableName$'_'config.language$'
567 if testLoadTable.table > 0
568 call loadTable 'buttonsTableName$'_'config.language$'
569 else
570 call loadTable 'buttonsTableName$'_EN
571 endif
572 .buttonsLang$ = selected$("Table")
573 for .row to .numLabels
574 select Table 'buttons$'
575 .label$ = Get value... '.row' Label
576 call findLabel '.buttonsLang$' '.label$'
577 if findLabel.row > 0
578 select Table '.buttonsLang$'
579 .valueText$ = Get value... 'findLabel.row' Text
580 .valueKey$ = Get value... 'findLabel.row' Key
581 .valueHelp$ = Get value... 'findLabel.row' Helptext
582 select Table 'buttons$'
583 Set string value... '.row' Text '.valueText$'
584 Set string value... '.row' Key '.valueKey$'
585 Set string value... '.row' Helptext '.valueHelp$'
586 elsif index(.label$, "_")
587 # Load alternative language table
588 .startChar = rindex(.label$, "_")
589 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
590 call loadTable 'buttonsTableName$'_'.otherLanguage$'
591 .otherbuttonsLang$ = selected$("Table")
592 call findLabel '.otherbuttonsLang$' '.label$'
593 if findLabel.row > 0
594 select Table '.buttonsLang$'
595 .valueText$ = Get value... 'findLabel.row' Text
596 .valueKey$ = Get value... 'findLabel.row' Key
597 .valueHelp$ = Get value... 'findLabel.row' Helptext
598 select Table 'buttons$'
599 Set string value... '.row' Text '.valueText$'
600 Set string value... '.row' Key '.valueKey$'
601 Set string value... '.row' Helptext '.valueHelp$'
602 else
603 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
604 endif
605 select Table '.otherbuttonsLang$'
606 Remove
607 else
608 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
609 endif
610 endfor
611 select Table '.buttonsLang$'
612 Remove
614 # Load configuration table
615 call loadTable 'configTableName$'
616 config$ = selected$("Table")
617 .configTable = selected()
618 # Substitute or remove optional languages
619 .optRow = Search column: "Label", "!Language_???"
620 if .optRow > 0
621 .row = -1
622 if sgc.customLanguage$ <> ""
623 .row = Search column: "Label", "Language_"+sgc.customLanguage$
624 endif
625 if .row <= 0 and sgc.customLanguage$ <> ""
626 Set string value: .optRow, "Label", "Language_"+sgc.customLanguage$
627 else
628 .tableLength = Get number of rows
629 # Should never ever happen
630 if .tableLength > 1
631 Remove row: .optRow
632 else
633 Set string value: .optRow, "Label", "Language_EN"
634 endif
635 endif
636 endif
638 select .configTable
639 Append column... Text
640 Append column... Key
641 Append column... Helptext
642 .numLabels = Get number of rows
643 call testLoadTable 'configTableName$'_'config.language$'
644 if testLoadTable.table > 0
645 call loadTable 'configTableName$'_'config.language$'
646 else
647 call loadTable 'configTableName$'_EN
648 endif
649 .configLang$ = selected$("Table")
650 for .row to .numLabels
651 select Table 'config$'
652 .label$ = Get value... '.row' Label
653 call findLabel '.configLang$' '.label$'
654 if findLabel.row > 0
655 select Table '.configLang$'
656 .valueText$ = Get value... 'findLabel.row' Text
657 .valueKey$ = Get value... 'findLabel.row' Key
658 .valueHelp$ = Get value... 'findLabel.row' Helptext
659 select Table 'config$'
660 Set string value... '.row' Text '.valueText$'
661 Set string value... '.row' Key '.valueKey$'
662 Set string value... '.row' Helptext '.valueHelp$'
663 elsif index(.label$, "_")
664 .startChar = rindex(.label$, "_")
665 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
666 call loadTable 'configTableName$'_'.otherLanguage$'
667 .otherconfigLang$ = selected$("Table")
668 call findLabel '.otherconfigLang$' '.label$'
669 if findLabel.row > 0
670 select Table '.otherconfigLang$'
671 .valueText$ = Get value... 'findLabel.row' Text
672 .valueKey$ = Get value... 'findLabel.row' Key
673 .valueHelp$ = Get value... 'findLabel.row' Helptext
674 select Table 'config$'
675 Set string value... '.row' Text '.valueText$'
676 Set string value... '.row' Key '.valueKey$'
677 Set string value... '.row' Helptext '.valueHelp$'
678 else
679 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
680 endif
681 select Table '.otherconfigLang$'
682 Remove
683 else
684 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
685 endif
686 endfor
687 select Table '.configLang$'
688 Remove
690 # Make language change visible
691 if .redraw_config
692 call Draw_config_page
693 endif
695 endproc
697 ###############################################################
698 #
699 # Button Drawing Routines
700 #
701 ###############################################################
703 # A stub for buttons that do not have a drawing routine (yet)
704 procedure DrawNull .color$ .x .y .size
705 endproc
707 procedure DrawHelp .color$ .x .y .size
708 .currentFontSize = 24
709 .y -= .size
710 .maxHeight = 2*.size
711 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
712 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
713 call set_font_size '.currentFontSize'
714 demo Colour... '.color$'
715 demo Text... '.x' Centre '.y' Bottom ?
716 call set_font_size 'defaultFontSize'
717 endproc
719 ###############################################################
720 #
721 # Button Processing Routines
722 #
723 ###############################################################
725 # Search row in table on label
726 procedure findKey .table$ .label$
727 .row = 0
728 select Table '.table$'
729 .to$ = selected$("Table")
730 .to$ = "Table_"+.to$
731 .numRows = Get number of rows
732 for .i to .numRows
733 .currentKey$ = '.to$'$[.i, "Key"]
734 if .label$ = .currentKey$
735 .row = .i
736 goto KEYFOUND
737 endif
738 endfor
739 label KEYFOUND
740 if .row <= 0 and index(.label$, "_") <= 0
741 printline "'.label$'" is not a key in '.table$'
742 endif
743 endproc
745 procedure findLabel .table$ .label$
746 .row = 0
747 select Table '.table$'
748 .to$ = selected$("Table")
749 .to$ = "Table_"+.to$
750 .numRows = Get number of rows
751 for .i to .numRows
752 .currentKey$ = '.to$'$[.i, "Label"]
753 if .label$ = .currentKey$
754 .row = .i
755 goto LABELFOUND
756 endif
757 endfor
758 label LABELFOUND
759 if .row <= 0 and index(.label$, "_") <= 0
760 call emergency_table_exit "'.label$'" is not a key in '.table$'
761 endif
762 endproc
764 # Get the label
765 procedure buttonClicked table$ .x .y
766 .label$ = ""
767 select Table 'table$'
768 .bo$ = selected$("Table")
769 .bo$ = "Table_"+.bo$
770 .numRows = Get number of rows
771 for .i to .numRows
772 if .label$ = ""
773 .leftX = '.bo$'[.i, "LeftX"]
774 .rightX = '.bo$'[.i, "RightX"]
775 .lowY = '.bo$'[.i, "LowY"]
776 .highY = '.bo$'[.i, "HighY"]
777 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
778 .label$ = '.bo$'$[.i, "Label"]
779 endif
780 endif
781 endfor
782 endproc
784 procedure keyPressed table$ .pressed$
785 .label$ = ""
786 # Magic
787 if .pressed$ = "" and not demoShiftKeyPressed()
788 .label$ = "Refresh"
789 endif
790 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
791 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
792 select Table 'table$'
793 .bo$ = selected$("Table")
794 .bo$ = "Table_"+.bo$
795 .numRows = Get number of rows
796 for .i to .numRows
797 if .label$ = ""
798 .key$ = '.bo$'$[.i, "Key"]
799 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
800 .label$ = '.bo$'$[.i, "Label"]
801 endif
802 endif
803 endfor
804 endproc
806 procedure count_syllables
807 .number = 0
808 .pinyin$ = ""
809 select sgc.currentWordlist
810 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
811 .sound$ = Get value... 'sgc.currentWord' Sound
812 call readPinyin 'sgc.currentWord'
813 .pinyin$ = readPinyin.pinyin$
814 endif
815 call add_missing_neutral_tones '.pinyin$'
816 .pinyin$ = add_missing_neutral_tones.pinyin$
817 if index_regex(.pinyin$, "[0-9]") > 0
818 .number = length(replace_regex$(.pinyin$, "[^\d]+([\d]+)", "1", 0))
819 elsif .pinyin$ <> ""
820 .number = 1
821 endif
822 endproc
824 procedure play_sound .sound
825 if .sound > 0
826 if sgc.useAlternativePlayer and fileReadable(sgc.playCommandFile$)
827 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
828 select .sound
829 Save as WAV file: .scratchFile$
830 .command$ < 'sgc.playCommandFile$'
831 .command$ = replace$(.command$, "[']", """", 0)
832 .command$ = replace$(.command$, "'newline$'", " ", 0)
833 if unix or macintosh
834 system_nocheck bash -c -- ''.command$' "'.scratchFile$'"'
835 elsif windows
836 system_nocheck call '.command$' "'.scratchFile$'"
837 endif
838 deleteFile(.scratchFile$)
839 else
840 select .sound
841 Play
842 endif
843 endif
844 endproc
846 procedure record_sound .recordingTime
847 if .recordingTime <= 0
848 .recordingTime = recordingTime
849 endif
850 call clean_up_sound
852 # NOTE: Some sound can be playing! This will not be stopped.
854 # There is a very nasty delay before the first recording starts, do a dummy record
855 if not variableExists("recordingInitialized") and not sgc.useAlternativeRecorder
856 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 0.1
857 Remove
858 recordingInitialized = 1
859 endif
860 # Recording light
861 demo Paint circle... Red 5 95 2
862 demoShow()
864 # In Windows XP interaction between demoWaitForInput and Record Sound blocks drawing the feedback
865 # This code might be removed #
866 if windows and endsWith(build_SHA$, " XP")
867 # Display a pause window to flush the graphics buffer
868 beginPause ("DESTROY WINDOW ")
869 comment (" ")
870 endPause ("DESTROY WINDOW ", 1)
871 #call init_window
872 demo Paint circle... Red 5 95 2
873 demoShow()
874 endif
875 ##############################
877 # Use a different recorder program
878 if sgc.useAlternativeRecorder and fileReadable(sgc.recordCommandFile$)
879 .scratchFile$ = "'sgc.scratchAudioDir$'SCRATCH.wav"
880 .command$ < 'sgc.recordCommandFile$'
881 .command$ = replace$(.command$, "[']", """", 0)
882 .command$ = replace$(.command$, "'newline$'", " ", 0)
883 if unix or macintosh
884 system_nocheck bash -c -- ''.command$' '.recordingTime''
885 elsif windows
886 system_nocheck call '.command$' '.recordingTime'
887 endif
888 Read from file: .scratchFile$
889 deleteFile(.scratchFile$)
890 else
891 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' '.recordingTime'
892 endif
893 demo Paint circle... White 5 95 2.5
894 call wipeArea 'wipeFeedbackArea$'
896 # Feedback on recording level
897 .extremum = Get absolute extremum... 0 0 None
898 .radius = 2 * .extremum
899 if .radius <= 0
900 .radius = 0.02
901 endif
902 .blue = 0
903 .green = 0
904 .red = 0
905 if .extremum >= 0.95
906 .red = 1
907 elsif .extremum >= 0.49
908 .green = 1
909 else
910 .green = .extremum / 0.5
911 endif
912 .color$ = "{'.red','.green','.blue'}"
913 demo Colour... '.color$'
914 demo Line width... 1
915 demo Draw circle... 5 95 '.radius'
916 # Reset
917 demoShow()
918 demo Colour... Black
919 demo Line width... 'defaultLineWidth'
920 # Process sound
921 Rename... Tmp
922 Resample... 10000 50
923 Rename... Pronunciation
924 recordedSound$ = selected$("Sound")
925 sgc.recordedSound = selected("Sound")
926 select Sound Tmp
927 Remove
928 select Sound 'recordedSound$'
929 sgc.recordedSound = selected("Sound")
931 # Cut out real sound from silences/noise
932 call sound_detection 'recordedSound$' 'soundMargin'
933 select Sound 'recordedSound$'
934 sgc.recordedSound = selected("Sound")
936 # Store audio if requested
937 if sgc.saveAudioOn and sgc.saveAudio$ <> ""
938 if sgc.savePerf$ <> "" and fileReadable(sgc.savePerf$)
939 .pinyin$ = ""
940 select sgc.currentWordlist
941 if sgc.currentWord > 0 and sgc.currentWord <= sgc.numberOfWords
942 call readPinyin 'sgc.currentWord'
943 .pinyin$ = readPinyin.pinyin$
944 .outputName$ = "'sgc.saveAudio$'/'.pinyin$'.wav"
945 select sgc.recordedSound
946 Save as WAV file: .outputName$
947 endif
948 else
949 # The Audio directory disappeared
950 sgc.savePerf$ = ""
951 sgc.saveAudioOn = 0
952 sgc.saveAudio$ = ""
953 config.savePerf = 0
954 config.openPerf = 0
955 config.clearSummary = 0
956 config.audioName$ = ""
957 endif
958 endif
960 endproc
963 # Select real sound from recording
964 # Uses some global variable
965 procedure sound_detection .sound$ .margin
966 select Sound '.sound$'
967 .soundlength = Get total duration
968 .internalSilence = 2*.margin
970 # Silence and remove noise, DANGEROUS
971 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
972 Rename... Input'.sound$'
974 select TextGrid Input'.sound$'
975 .numberofIntervals = Get number of intervals... 1
976 if .numberofIntervals < 2
977 .numberofIntervals = 0
978 endif
980 # The code below will suppress noise, but also weak third tones
981 # This handles the problem that third tones can be realized with
982 # alternative cues, e.g, non-standard voice and very low levels
983 #
984 # Remove buzzing and other obnoxious sounds (if switched on)
985 for .i from 1 to .numberofIntervals
986 select TextGrid Input'.sound$'
987 .value$ = Get label of interval... 1 '.i'
988 .begintime = Get starting point... 1 '.i'
989 .endtime = Get end point... 1 '.i'
991 # Remove noise
992 if .value$ = "silent"
993 select Sound '.sound$'
994 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
995 endif
996 endfor
998 # Select target sound
999 .maximumIntensity = -1
1000 .counter = 1
1001 for i from 1 to .numberofIntervals
1002 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 if .value$ != "silent"
1009 if .begintime > .margin
1010 .begintime -= .margin
1011 else
1012 .begintime = 0
1013 endif
1014 if .endtime + .margin < .soundlength
1015 .endtime += .margin
1016 else
1017 .endtime = .soundlength
1018 endif
1020 select Sound '.sound$'
1021 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
1022 Rename... Tmp'.sound$'
1023 Subtract mean
1024 .newIntensity = Get intensity (dB)
1025 if .newIntensity > .maximumIntensity
1026 if .maximumIntensity > 0
1027 select Sound New'.sound$'
1028 Remove
1029 endif
1030 select Sound Tmp'.sound$'
1031 Rename... New'.sound$'
1032 .maximumIntensity = .newIntensity
1033 else
1034 select Sound Tmp'.sound$'
1035 Remove
1036 endif
1037 #
1038 endif
1039 endfor
1040 if .maximumIntensity > minimumIntensity
1041 select Sound '.sound$'
1042 Remove
1043 select Sound New'.sound$'
1044 Rename... '.sound$'
1045 elsif .maximumIntensity > -1
1046 select Sound New'.sound$'
1047 Remove
1048 endif
1049 select TextGrid Input'.sound$'
1050 Remove
1052 select Sound '.sound$'
1053 endproc
1055 procedure end_program
1056 call write_preferences ""
1057 demo Erase all
1058 select all
1059 Remove
1060 exit
1061 endproc
1063 ######################################################
1064 #
1065 # Configuration Page
1066 #
1067 ######################################################
1068 procedure config_page
1069 demo Erase all
1070 demoWindowTitle("Speak Good Chinese: Change settings")
1071 .label$ = ""
1072 call Draw_config_page
1074 goto GOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1076 while (.label$ <> "Return") and demoWaitForInput()
1077 .clickX = -1
1078 .clickY = -1
1079 .pressed$ = ""
1080 .label$ = ""
1081 if demoClicked()
1082 .clickX = demoX()
1083 .clickY = demoY()
1084 call buttonClicked 'config$' '.clickX' '.clickY'
1085 .label$ = buttonClicked.label$
1086 elsif demoKeyPressed()
1087 .pressed$ = demoKey$()
1088 call keyPressed 'config$' '.pressed$'
1089 .label$ = keyPressed.label$
1090 endif
1092 # You cannot select a text field
1093 if startsWith(.label$, "$")
1094 .label$ = ""
1095 endif
1097 # Do things
1098 if .label$ != ""
1099 # Handle push button in process_config
1100 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
1101 endif
1103 if .label$ = "Return"
1104 goto GOBACK
1105 endif
1106 endwhile
1108 # Go back
1109 label GOBACK
1110 call init_window
1111 endproc
1113 procedure Draw_config_page
1114 demo Erase all
1115 # Draw background
1116 if config.showBackground
1117 call draw_background Background
1118 endif
1119 # Draw buttons
1120 call Draw_all_buttons 'config$'
1121 call set_window_title 'config$'
1122 # Set correct buttons (alert)
1123 call setConfigMainPage
1124 endproc
1126 # Do what is asked
1127 procedure process_config .label$ .clickX .clickY .pressed$
1128 if .label$ <> "" and not startsWith(.label$,"!")
1129 .label$ = replace_regex$(.label$, "^[#]", "", 0)
1130 .label$ = replace$(.label$, "_", " ", 0)
1132 # Log activity
1133 'sgc2.logging$' call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1135 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
1136 endif
1137 endproc
1139 ###############################################################
1140 #
1141 # Presenting help texts
1142 #
1143 ###############################################################
1145 # Process Help
1146 procedure help_loop .table$ .redrawProc$
1147 # General Help text
1148 call write_help_title '.table$'
1151 .label$ = ""
1152 call Draw_button '.table$' Help 2
1153 goto HELPGOBACK index_regex(replaySGC2Log$, "^\s*#") <= 0
1155 .redrawScreen = 0
1156 while (.label$ <> "Help") and demoWaitForInput()
1157 .label$ = ""
1158 if demoClicked()
1159 .clickX = demoX()
1160 .clickY = demoY()
1161 call buttonClicked '.table$' '.clickX' '.clickY'
1162 .label$ = buttonClicked.label$
1163 elsif demoKeyPressed()
1164 .pressed$ = demoKey$()
1165 call keyPressed '.table$' '.pressed$'
1166 .label$ = keyPressed.label$
1167 endif
1169 if .label$ != "" and .label$ <> "Help"
1170 # Redraw screen
1171 if .redrawScreen
1172 demo Erase all
1173 call '.redrawProc$'
1174 else
1175 .redrawScreen = 1
1176 endif
1177 call Draw_button '.table$' Help 2
1178 call write_help_title '.table$'
1180 # Handle push button in process_config
1181 call write_help_text '.table$' '.label$'
1183 # Log activity
1184 'sgc2.logging$' demo Erase all
1185 'sgc2.logging$' call '.redrawProc$'
1186 'sgc2.logging$' call write_help_title '.table$'
1187 'sgc2.logging$' call write_help_text '.table$' '.label$'
1188 endif
1190 endwhile
1192 label HELPGOBACK
1193 # Reset button
1194 call Draw_button '.table$' Help 0
1195 demo Erase all
1196 call '.redrawProc$'
1197 endproc
1199 # Write help text
1200 procedure write_help_text .table$ .label$
1201 call findLabel '.table$' '.label$'
1202 .row = findLabel.row
1203 select Table '.table$'
1204 # Get text
1205 if .row <= 0
1206 call findLabel '.table$' Help
1207 .row = findLabel.row
1208 select Table '.table$'
1209 endif
1210 .helpText$ = Get value... '.row' Helptext
1211 .helpKey$ = Get value... '.row' Key
1212 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1213 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1214 if index_regex(.helpKey$, "\S")
1215 .helpText$ = .helpText$+" ("+.helpKey$+")"
1216 endif
1217 # Get button values
1218 .leftX = Get value... '.row' LeftX
1219 .rightX = Get value... '.row' RightX
1220 .lowY = Get value... '.row' LowY
1221 .highY = Get value... '.row' HighY
1223 # PopUp dimensions
1224 .currentHelpFontSize = defaultFontSize
1225 call set_font_size '.currentHelpFontSize'
1226 .helpTextSize = demo Text width (wc)... '.helpText$'
1227 .helpTextSize += 4
1228 if .leftX > 50
1229 .htXleft = 20
1230 .htXright = .htXleft + .helpTextSize + 5
1231 .xstart = .leftX
1232 else
1233 .htXright = 80
1234 .htXleft = .htXright - .helpTextSize - 5
1235 .xstart = .rightX
1236 endif
1237 if .lowY > 50
1238 .htYlow = 40
1239 .htYhigh = .htYlow + 7
1240 .ystart = .lowY
1241 .yend = .htYhigh
1242 else
1243 .htYhigh = 60
1244 .htYlow = .htYhigh - 7
1245 .ystart = .highY
1246 .yend = .htYlow
1247 endif
1249 # Adapt font size to horizontal dimensions
1250 .maxWidth = 90
1251 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1252 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1253 if .htXleft < 0 or .htXright > 100
1254 .htXleft = 0
1255 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1256 endif
1257 call set_font_size '.currentHelpFontSize'
1259 # Adapt vertical dimensions to font height
1260 call points_to_wc '.currentHelpFontSize'
1261 .lineHeight = points_to_wc.wc
1262 if .lineHeight > .htYhigh - .htYlow - 4
1263 .htYhigh = .htYlow + .lineHeight + 4
1264 endif
1266 # Determine arrow endpoints
1267 .xend = .htXleft
1268 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1269 .xend = .htXright
1270 endif
1271 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1272 .xend = (.htXleft+.htXright)/2
1273 endif
1275 .xtext = .htXleft + 2
1276 .ytext = .htYlow + 1
1278 # Draw pop-up
1279 .mm2wc = demo Horizontal mm to wc... 1
1280 .lineWidth = 2/.mm2wc
1281 demo Line width... '.lineWidth'
1282 demo Arrow size... '.lineWidth'
1283 demo Colour... 'sgc2.popUp_bordercolor$'
1284 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1285 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1286 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1287 demo Line width... 'defaultLineWidth'
1288 demo Arrow size... 1
1289 demo Black
1290 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1291 demoShow()
1292 call set_font_size 'defaultFontSize'
1294 endproc
1296 procedure write_help_title .table$
1297 # Set help text title
1298 # General Help text
1299 call findLabel '.table$' Help
1300 .row = findLabel.row
1301 select Table '.table$'
1302 .helpTitle$ = Get value... '.row' Helptext
1303 .helpKey$ = Get value... '.row' Key
1304 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1305 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1306 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1308 call reset_viewport
1309 .helpTitleFontSize = 14
1310 # Adapt size of button to length of text
1311 .maxWidth = 80
1312 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1313 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1314 call set_font_size '.helpTitleFontSize'
1315 .helpTop = 100
1317 demo Select inner viewport... 0 100 0 100
1318 demo Axes... 0 100 0 100
1319 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1320 call set_font_size 'defaultFontSize'
1321 call reset_viewport
1322 endproc
1324 ###############################################################
1325 #
1326 # Miscelaneous procedures
1327 #
1328 ###############################################################
1329 procedure printPageToPrinter
1330 call print_window
1331 demo Print... 'printerName$' 'printerPresets$'
1332 call init_window
1333 endproc
1335 procedure getOpenFile .openDialogue$
1336 call clean_up_sound
1338 call convert_praat_to_latin1 '.openDialogue$'
1339 .openDialogue$ = convert_praat_to_latin1.text$
1340 .filename$ = chooseReadFile$ (.openDialogue$)
1341 .tmp = -1
1342 if .filename$ <> "" and fileReadable(.filename$)
1343 .tmp = nocheck Read from file... '.filename$'
1344 if .tmp !- undefined and .tmp > 0
1345 call log_fileOpen '.filename$'
1347 # Get only the filename
1348 .startName = rindex_regex(.filename$, "[/\\:]") + 1
1349 .nameLength = rindex(.filename$, ".") - .startName
1350 currentSoundName$ = mid$(.filename$, .startName, .nameLength)
1351 else
1352 .tmp = -1
1353 endif
1354 endif
1355 if .tmp <= 0
1356 Create Sound from formula... Speech Mono 0 1 44100 0
1357 endif
1358 recordedSound$ = selected$("Sound")
1359 sgc.recordedSound = selected("Sound")
1360 currentStartTime = 0
1361 currentEndTime = Get total duration
1362 # Reset selected window
1363 selectedStartTime = currentStartTime
1364 selectedEndTime = currentEndTime
1365 endproc
1367 procedure points_to_wc .points
1368 .mm = .points * 0.3527777778
1369 .wc = demo Vertical mm to wc... '.mm'
1370 endproc
1372 procedure reset_viewport
1373 .low = viewportMargin
1374 .high = 100 - viewportMargin
1375 demo Select inner viewport... '.low' '.high' '.low' '.high'
1376 demo Axes... 0 100 0 100
1377 endproc
1379 procedure set_font_size .fontSize
1380 call reset_viewport
1381 demo Font size... '.fontSize'
1382 call reset_viewport
1383 endproc
1385 procedure wipeArea .areaCommand$
1386 call reset_viewport
1387 '.areaCommand$'
1388 endproc
1390 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1391 demo '.font$'
1392 call set_font_size '.currentFontSize'
1393 .textWidth = demo Text width (wc)... '.text$'
1394 while .textWidth > .maxWidth and .currentFontSize > 2
1395 .currentFontSize -= 0.5
1396 call set_font_size '.currentFontSize'
1397 .textWidth = demo Text width (wc)... '.text$'
1398 endwhile
1399 .diff = .textWidth - .maxWidth
1400 .newFontSize = .currentFontSize
1401 demo 'defaultFont$'
1402 endproc
1404 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1405 demo '.font$'
1406 .radians = .rotation/360 * 2 * pi
1407 .horWC = demo Horizontal mm to wc... 10.0
1408 .verWC = demo Vertical mm to wc... 10.0
1409 if .horWC > 0
1410 .verCoeff = .verWC / .horWC
1411 else
1412 .verCoeff = 1
1413 endif
1414 call set_font_size '.currentFontSize'
1415 .textLength = demo Text width (wc)... '.text$'
1416 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1417 .currentFontSize -= 0.5
1418 call set_font_size '.currentFontSize'
1419 .textLength = demo Text width (wc)... '.text$'
1420 endwhile
1421 .diff = .textLength - .maxHeight
1422 .newFontSize = .currentFontSize
1423 demo 'defaultFont$'
1424 endproc
1426 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1427 demo '.font$'
1428 call points_to_wc '.currentFontSize'
1429 .lineHeight = points_to_wc.wc
1430 while .lineHeight > .maxHeight and .currentFontSize > 2
1431 .currentFontSize -= 0.5
1432 call points_to_wc '.currentFontSize'
1433 .lineHeight = points_to_wc.wc
1434 endwhile
1435 .diff = .lineHeight - .maxHeight
1436 .newFontSize = .currentFontSize
1437 demo 'defaultFont$'
1438 endproc
1440 # Load a table with button info etc.
1441 # Load local tables if present. Else load
1442 # build-in scripted tables
1443 procedure loadTable .tableName$
1444 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1445 # Search for the table in local, preference, and global directories
1446 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1447 .table = Read from file... 'localTableDir$'/'.tableName$'.Table
1448 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1449 .table = Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1450 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1451 .table = Read from file... 'globaltablelists$'/'.tableName$'.Table
1452 # Load them from script
1453 elsif variableExists("procCreate'.tableVariableName$'$")
1454 call Create'.tableVariableName$'
1455 Rename: .tableName$
1456 .table = selected("Table")
1457 else
1458 call emergency_table_exit '.tableName$' cannot be found
1459 endif
1461 # Check whether this is a real table
1462 selectObject: .table
1463 .fullName$ = selected$ ()
1464 .type$ = extractWord$(.fullName$, "")
1465 if .type$ <> "Table"
1466 Remove
1467 .table = -1
1468 endif
1470 if .table <= 0
1471 call emergency_table_exit '.tableFileName$' corrupted or cannot be found
1472 endif
1473 endproc
1475 procedure testLoadTable .tableName$
1476 .table = 0
1477 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1478 # Search for the table in local, preference, and global directories
1479 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1480 .table = 1
1481 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1482 .table = 2
1483 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1484 .table = 3
1485 # Load them from script
1486 elsif variableExists("procCreate'.tableVariableName$'$")
1487 .table = 4
1488 else
1489 .table = 0
1490 endif
1491 endproc
1493 procedure checkTable .tableName$
1494 .available = 0
1495 if localTableDir$ <> "" and fileReadable("'localTableDir$'/'.tableName$'.Table")
1496 .available = 1
1497 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1498 .available = 1
1499 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1500 .available = 1
1501 # Load them from script
1502 elsif variableExists("procCreate'.tableName$'$")
1503 .available = 1
1504 else
1505 .available = 0
1506 endif
1507 endproc
1509 # Create a pop-up window with text from a Text Table
1510 procedure write_text_table .table$
1511 .xleft = 10
1512 .xright = 90
1513 .ylow = 20
1514 .yhigh = 85
1515 .lineHeight = 2.5
1517 # Get table with text and longest line
1518 .numLines = 0
1519 call testLoadTable '.table$'
1520 if testLoadTable.table > 0
1521 call loadTable '.table$'
1522 .instructionText = selected()
1523 .numLines = Get number of rows
1524 else
1525 goto ESCAPEwrite_text_table
1526 endif
1527 .instructionFontSize = 14
1528 .referenceText$ = ""
1529 .maxlenght = 0
1530 .maxLine = 0
1531 .maxFontSize = 0
1532 .maxWidth = 0
1533 for .l to .numLines
1534 select '.instructionText'
1535 .currentText$ = Get value... '.l' text
1536 # Expand variables, eg, 'praatVersion$'
1537 call expand_praat_variables '.currentText$'
1538 .currentText$ = expand_praat_variables.text$
1540 .font$ = Get value... '.l' font
1541 .fontSize = Get value... '.l' size
1542 call set_font_size '.fontSize'
1543 .textWidth = demo Text width (wc)... '.currentText$'
1544 if .fontSize > .maxFontSize
1545 .maxFontSize = .fontSize
1546 endif
1547 if .textWidth > .maxWidth
1548 .maxWidth = .textWidth
1549 .instructionFontSize = .fontSize
1550 .maxLine = .l
1551 endif
1552 endfor
1553 select '.instructionText'
1554 .referenceText$ = Get value... '.maxLine' text
1555 .maxLineFont$ = Get value... '.maxLine' font
1556 .instructionFontSize = Get value... '.maxLine' size
1557 call set_font_size '.maxFontSize'
1559 # Adapt size of button to length of text
1560 .maxWidth = (.xright - .xleft) - 4
1561 .origFontSize = .instructionFontSize
1562 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1563 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1564 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1565 if adjustFontSizeOnWidth.diff > 0
1566 .xright += adjustFontSizeOnWidth.diff/4
1567 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1568 endif
1569 call set_font_size '.instructionFontSize'
1570 .fontSizeFactor = .instructionFontSize / .origFontSize
1572 .numRows = Get number of rows
1573 # Calculate length from number of lines.
1574 .dy = .lineHeight
1575 .midY = .yhigh - (.yhigh - .ylow)/2
1576 .yhigh = .midY + (.numRows+1) * .dy / 2
1577 .ylow = .yhigh - (.numRows+1) * .dy
1578 .textleft = .xleft + 2
1580 demo Line width... 8
1581 demo Colour... 'sgc2.popUp_bordercolor$'
1582 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1583 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1584 demo Line width... 'defaultLineWidth'
1585 demo Black
1586 .ytext = .yhigh - 2 - .dy
1587 for .i to .numRows
1588 select '.instructionText'
1589 .font$ = Get value... '.i' font
1590 .fontSize = Get value... '.i' size
1591 .font$ = extractWord$(.font$, "")
1592 # Scale font
1593 .fontSize = floor(.fontSize*.fontSizeFactor)
1594 if .fontSize < 4
1595 .fontSize = 4
1596 endif
1597 .line$ = Get value... '.i' text
1598 # Expand variables, eg, 'praatVersion$'
1599 call expand_praat_variables '.line$'
1600 .line$ = expand_praat_variables.text$
1602 # Display text
1603 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1604 .ytext -= .dy
1605 endfor
1606 demoShow()
1607 call set_font_size 'defaultFontSize'
1609 select '.instructionText'
1610 Remove
1612 label ESCAPEwrite_text_table
1613 endproc
1616 # Create a pop-up window with text from an existing Table object
1617 procedure write_tabbed_table .table$ .labelTextTable$
1618 .xleft = 0
1619 .xright = 100
1620 .ylow = 20
1621 .yhigh = 85
1622 .lineHeight = 2.5
1624 # Get table with text and longest line
1625 call testLoadTable '.table$'
1626 if testLoadTable.table <= 0
1627 call loadTable '.labelTextTable$'
1628 .labelText$ = selected$("Table")
1629 endif
1631 select Table '.table$'
1632 .tabbedText = selected()
1633 .numLines = Get number of rows
1634 .numCols = Get number of columns
1635 .font$ = defaultFont$
1636 .fontSize = defaultFontSize
1637 # Standard width
1638 .widthCanvas = .xright - .xleft
1639 .dx = (.widthCanvas - 4) / (.numCols)
1641 # Get longest entry
1642 demo '.font$'
1643 call set_font_size '.fontSize'
1644 .maxWidth = 0
1645 for .i from 0 to .numLines
1646 .xtext = .xleft + .dx / 2
1647 for .j to .numCols
1648 select '.tabbedText'
1649 .currentLabel$ = Get column label... '.j'
1650 if .i > 0
1651 .line$ = Get value... '.i' '.currentLabel$'
1652 else
1653 .line$ = .currentLabel$
1654 select Table '.labelText$'
1655 call findLabel '.labelText$' '.line$'
1656 select Table '.labelText$'
1657 .line$ = Get value... 'findLabel.row' Text
1658 endif
1659 # Expand variables, eg, 'praatVersion$'
1660 call expand_praat_variables '.line$'
1661 .line$ = expand_praat_variables.text$
1662 .textWidth = demo Text width (wc)... '.line$'
1663 if .textWidth > .maxWidth
1664 .maxWidth = .textWidth
1665 endif
1666 endfor
1667 endfor
1668 if .dx > 1.2 * .maxWidth
1669 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1670 .xleft = 50 - .widthCanvas / 2
1671 .xright = 50 + .widthCanvas / 2
1672 .dx = (.widthCanvas - 4) / (.numCols)
1673 else
1674 .maxWidth = .dx - 1
1675 endif
1677 # Calculate length from number of lines.
1678 .dy = .lineHeight + 0.5
1679 .midY = .yhigh - (.yhigh - .ylow)/2
1680 .yhigh = .midY + (.numLines+2) * .dy / 2
1681 .ylow = .yhigh - (.numLines+2) * .dy
1682 .textleft = .xleft + 2
1684 demo Line width... 8
1685 demo Colour... 'sgc2.popUp_bordercolor$'
1686 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1687 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1688 demo Line width... 'defaultLineWidth'
1689 demo Black
1690 .ytext = .yhigh - 2 - .dy
1691 # First the column names, then the items
1692 for .i from 0 to .numLines
1693 .xtext = .textleft + .dx / 2
1694 for .j to .numCols
1695 select '.tabbedText'
1696 .currentLabel$ = Get column label... '.j'
1697 if .i > 0
1698 .line$ = Get value... '.i' '.currentLabel$'
1699 else
1700 .line$ = .currentLabel$
1701 select Table '.labelText$'
1702 call findLabel '.labelText$' '.line$'
1703 select Table '.labelText$'
1704 .line$ = Get value... 'findLabel.row' Text
1705 endif
1706 # Expand variables, eg, 'praatVersion$'
1707 call expand_praat_variables '.line$'
1708 .line$ = expand_praat_variables.text$
1709 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1710 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1712 # Display text
1713 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1714 .xtext += .dx
1715 endfor
1716 .ytext -= .dy
1717 endfor
1718 demoShow()
1719 call set_font_size 'defaultFontSize'
1720 select Table '.labelText$'
1721 Remove
1723 label ESCAPEwrite_tabbed_table
1724 endproc
1726 # Create a pop-up window with a given text
1727 procedure write_text_popup .font$ .size .text$
1728 .xleft = 10
1729 .xright = 90
1730 .ylow = 20
1731 .yhigh = 85
1732 .lineHeight = 3
1734 # Adapt size of button to length of text
1735 .maxWidth = (.xright - .xleft) - 4
1736 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1737 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1738 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1739 if adjustFontSizeOnWidth.diff > 0
1740 .xright += adjustFontSizeOnWidth.diff/4
1741 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1742 else
1743 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1744 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1745 endif
1747 .numRows = 1
1748 # Calculate length from number of lines.
1749 .dy = .lineHeight
1750 .midY = .yhigh - (.yhigh - .ylow)/2
1751 .yhigh = .midY + (.numRows+1) * .dy / 2
1752 .ylow = .yhigh - (.numRows+1) * .dy
1753 .textleft = .xleft + 2
1754 .xmid = (.textleft + .xright - 2)/2
1756 demo Line width... 8
1757 demo Colour... 'sgc2.popUp_bordercolor$'
1758 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1759 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1760 demo Line width... 'defaultLineWidth'
1761 demo Black
1762 .ytext = .yhigh - 2 - .dy
1763 # Write text
1764 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1766 demoShow()
1767 demo 'defaultFont$'
1768 call set_font_size 'defaultFontSize'
1769 endproc
1771 # Write the background from a Text Table
1772 procedure draw_background .table$
1773 .xleft = 0
1774 .xright = 100
1775 .ylow = 0
1776 .yhigh = 100
1777 .lineHeight = 5
1778 .defaultColour$ = "{0.9,0.9,0.9}"
1779 .defaultAlign$ = "centre"
1781 # Get table with text and longest line
1782 call loadTable '.table$'
1783 .backgroundText = selected()
1784 .numLines = Get number of rows
1785 .backgroundFontSize = 28
1786 .referenceText$ = ""
1787 .maxlenght = 0
1788 .maxLine = 0
1789 .maxFontSize = 0
1790 .maxWidth = 0
1791 .textLines = 0
1792 for .l to .numLines
1793 select '.backgroundText'
1794 .currentText$ = Get value... '.l' text
1795 # Expand variables, eg, 'praatVersion$'
1796 call expand_praat_variables '.currentText$'
1797 .currentText$ = expand_praat_variables.text$
1799 .font$ = Get value... '.l' font
1800 .fontSize = Get value... '.l' size
1801 if .fontSize > .maxFontSize
1802 .maxFontSize = .fontSize
1803 endif
1804 if not startsWith(.font$, "!")
1805 call set_font_size '.fontSize'
1806 .textWidth = demo Text width (wc)... '.currentText$'
1807 if .textWidth > .maxWidth
1808 .maxWidth = .textWidth
1809 .backgroundFontSize = .fontSize
1810 .maxLine = .l
1811 endif
1813 .textLines += 1
1814 endif
1815 endfor
1816 if .maxLine > 0
1817 select '.backgroundText'
1818 .referenceText$ = Get value... '.maxLine' text
1819 .maxLineFont$ = Get value... '.maxLine' font
1820 .backgroundFontSize = Get value... '.maxLine' size
1821 .backgroundFontColour$ = Get value... '.maxLine' colour
1822 call set_font_size '.maxFontSize'
1823 else
1824 .maxFontSize = .backgroundFontSize
1825 endif
1827 # Adapt size of button to length of text
1828 .maxWidth = (.xright - .xleft) - 4
1829 .origFontSize = .backgroundFontSize
1830 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1831 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1832 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1833 call set_font_size '.backgroundFontSize'
1835 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1836 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1837 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1838 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1839 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1840 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1841 endif
1843 .numRows = Get number of rows
1844 # Calculate length from number of lines.
1845 .dy = .lineHeight
1846 .midY = .yhigh - (.yhigh - .ylow)/2
1847 .yhigh = .midY + (.textLines+1) * .dy / 2
1848 .ylow = .yhigh - (.textLines+1) * .dy
1849 .textleft = .xleft + 2
1850 .textright = .xright - 2
1851 .textmid = (.xright - .xleft)/2
1853 demo Black
1854 .ytext = .yhigh - 2 - .dy
1855 for .i to .numRows
1856 select '.backgroundText'
1857 .font$ = Get value... '.i' font
1858 .fontSize = Get value... '.i' size
1859 .fontColour$ = Get value... '.i' colour
1860 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1861 .fontAlign$ = Get value... '.i' align
1862 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1863 .line$ = Get value... '.i' text
1864 # Expand variables, eg, 'praatVersion$'
1865 call expand_praat_variables '.line$'
1866 .line$ = expand_praat_variables.text$
1868 # Scale font
1869 .fontSize = floor(.fontSize*.fontSizeFactor)
1870 if not startsWith(.font$, "!")
1871 .font$ = extractWord$(.font$, "")
1873 if .fontAlign$ = "centre"
1874 .xtext = .textmid
1875 elsif .fontAlign$ = "right"
1876 .xtext = .textright
1877 else
1878 .xtext = .textleft
1879 endif
1880 if .fontSize < 4
1881 .fontSize = 4
1882 endif
1883 # Clean up text
1884 demo Colour... '.fontColour$'
1885 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1886 .ytext -= .dy
1887 elsif .font$ = "!demo command"
1888 demo Colour... '.fontColour$'
1889 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1890 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1891 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1892 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1893 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1894 while index(.line$, "[[")
1895 .nextBracketOpen = index(.line$, "[[")
1896 .nextBracketOpen += 2
1897 .nextBracketClose = index(.line$, "]]")
1898 .bracketLength = .nextBracketClose - .nextBracketOpen
1899 .result$ = ""
1900 if .bracketLength > 0
1901 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1902 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1903 if length(.expression$) > 0
1904 # Test expression for security, only allow explicitely defined functions
1905 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1906 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1907 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1908 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1909 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1910 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1911 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1912 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1913 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1914 if .testExpression$ = ""
1915 .calc = '.expression$'
1916 .result$ = "'.calc'"
1917 endif
1918 endif
1919 endif
1921 # Replace expression by result
1922 .lastLeft = .nextBracketOpen - 3
1923 .newLine$ = left$(.line$, .lastLeft)
1924 .newLine$ = .newLine$ + .result$
1925 .numCopy = length(.line$) - .nextBracketClose - 1
1926 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1927 .line$ = .newLine$
1928 endwhile
1929 demo '.line$'
1930 endif
1931 endfor
1932 demo Black
1933 demoShow()
1934 call set_font_size 'defaultFontSize'
1936 select '.backgroundText'
1937 Remove
1938 endproc
1940 procedure convert_praat_to_utf8 .text$
1941 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1942 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1943 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1944 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1945 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1946 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1947 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1948 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1949 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1950 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1951 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1952 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1953 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1954 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1955 endproc
1957 procedure convert_praat_to_latin1 .text$
1958 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1959 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1960 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1961 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1962 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1963 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1964 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1965 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1966 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1967 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1968 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1969 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1970 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1971 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1972 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1973 endproc
1975 # Expand 'variable$' into the value of variable$.
1976 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1977 # Single quotes can be protected by \'
1978 procedure expand_praat_variables .text$
1979 if index(.text$, "'")
1980 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1981 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1982 .tempText$ = """"+.tempText$+""""
1983 # Check whether all the variables actually exist. Ignore any variable that does not exist
1984 .checkVars$ = .tempText$
1985 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1986 .start = index(.checkVars$, "+")
1987 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1988 .end = index(.checkVars$, "+")
1989 if .end
1990 .variable$ = left$(.checkVars$, .end - 1)
1991 if not variableExists(.variable$)
1992 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1993 endif
1994 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1995 else
1996 .checkVars$ = ""
1997 endif
1998 endwhile
1999 .text$ = '.tempText$'
2000 endif
2001 endproc
2003 # Get a time stamp in normalized format
2004 procedure getTimeStamp
2005 .currentDateTime$ = date$()
2006 .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)
2007 endproc
2009 # A table error, can be insiduously caused by an outdate preferences file!
2010 procedure emergency_table_exit .message$
2011 # If you come here as a user, your preferences file is borked
2012 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
2013 deleteFile(preferencesAppFile$)
2014 endif
2015 # Put out message
2016 call get_feedback_text 'config.language$' Cancel
2017 call convert_praat_to_latin1 'get_feedback_text.text$'
2018 .cancelText$ = convert_praat_to_latin1.text$
2019 beginPause: "Fatal Error"
2020 comment: .message$
2021 endPause: .cancelText$, 1
2022 exit '.message$'
2023 endproc
2025 # Remove previous files from system
2026 procedure clean_up_sound
2027 if recordedSound$ = ""
2028 sgc.recordedSound = 0
2029 endif
2030 if sgc.recordedSound > 0
2031 select sgc.recordedSound
2032 Remove
2033 recordedSound$ = ""
2034 sgc.recordedSound = 0
2035 endif
2036 if te.recordedPitch > 0
2037 select te.recordedPitch
2038 Remove
2039 te.recordedPitch = 0
2040 endif
2041 if sgc.alignedTextGrid > 0
2042 select sgc.alignedTextGrid
2043 Remove
2044 sgc.alignedTextGrid = -1
2045 endif
2046 endproc
2048 # Safely read a table
2049 procedure readTable .filename$
2050 .tableID = -1
2051 if .filename$ <> "" and fileReadable(.filename$) and index_regex(.filename$, "(?i\.(tsv|table|csv))$") > 0
2052 if index_regex(.filename$, "(?i\.(csv))$") > 0
2053 .tableID = Read Table from comma-separated file: .filename$
2054 elsif index_regex(.filename$, "(?i\.(tsv))$") > 0
2055 .tableID = nocheck Read Table from tab-separated file: .filename$
2056 else
2057 .tableID = nocheck Read from file... '.filename$'
2058 endif
2059 if .tableID = undefined or .tableID <= 0
2060 .tableID = -1
2061 else
2062 .fullName$ = selected$ ()
2063 .type$ = extractWord$(.fullName$, "")
2064 if .type$ <> "Table"
2065 Remove
2066 .tableID = -1
2067 endif
2068 endif
2069 endif
2070 endproc
2072 # Read feedback table and get keyed text
2073 procedure get_feedback_text .language$ .key$
2074 if not endsWith(feedbackTableName$, "_'.language$'")
2075 if feedbackTableName$ <> ""
2076 select Table 'feedbackTableName$'
2077 Remove
2078 endif
2079 call testLoadTable 'feedbackTablePrefix$'_'.language$'
2080 if testLoadTable.table > 0
2081 call loadTable 'feedbackTablePrefix$'_'.language$'
2082 else
2083 call loadTable 'feedbackTablePrefix$'_EN
2084 endif
2085 feedbackTableName$ = selected$("Table")
2086 endif
2087 call findKey 'feedbackTableName$' '.key$'
2088 .row = findKey.row
2089 select Table 'feedbackTableName$'
2090 .text$ = Get value... '.row' Text
2091 # Expand variables, eg, 'praatVersion$'
2092 call expand_praat_variables '.text$'
2093 .text$ = expand_praat_variables.text$
2094 endproc
2097 # Read evaluation table and get keyed text. Only praat converted Text
2098 procedure get_evaluation_text .language$ .key$
2099 if not endsWith(evaluationTableName$, "_'.language$'")
2100 if evaluationTableName$ <> ""
2101 select Table 'evaluationTableName$'
2102 Remove
2103 endif
2104 call testLoadTable 'evaluationTablePrefix$'_'.language$'
2105 if testLoadTable.table > 0
2106 call loadTable 'evaluationTablePrefix$'_'.language$'
2107 else
2108 call loadTable 'evaluationTablePrefix$'_EN
2109 endif
2110 evaluationTableName$ = selected$("Table")
2111 endif
2112 call findLabel 'evaluationTableName$' '.key$'
2113 .row = findLabel.row
2114 select Table 'evaluationTableName$'
2115 .text$ = Get value... '.row' Text
2116 # Expand variables, eg, 'praatVersion$'
2117 call expand_praat_variables '.text$'
2118 .rawtext$ = expand_praat_variables.text$
2119 call convert_praat_to_latin1 '.rawtext$'
2120 .text$ = convert_praat_to_latin1.text$
2121 endproc
2123 # Read all the relevant evaluation labels and put them in "eval.<label>$" variables
2124 procedure get_evaluation_table_labels .language$
2125 call get_evaluation_text '.language$' Performance
2126 eval.performance$ = get_evaluation_text.text$
2127 call get_evaluation_text '.language$' Pinyin
2128 eval.pinyin$ = get_evaluation_text.text$
2129 call get_evaluation_text '.language$' Correct
2130 eval.correct$ = get_evaluation_text.text$
2131 call get_evaluation_text '.language$' Wrong
2132 eval.wrong$ = get_evaluation_text.text$
2133 call get_evaluation_text '.language$' Total
2134 eval.total$ = get_evaluation_text.text$
2135 call get_evaluation_text '.language$' High
2136 eval.high$ = get_evaluation_text.text$
2137 call get_evaluation_text '.language$' Low
2138 eval.low$ = get_evaluation_text.text$
2139 call get_evaluation_text '.language$' Wide
2140 eval.wide$ = get_evaluation_text.text$
2141 call get_evaluation_text '.language$' Narrow
2142 eval.narrow$ = get_evaluation_text.text$
2143 call get_evaluation_text '.language$' Unknown
2144 eval.unknown$ = get_evaluation_text.text$
2145 call get_evaluation_text '.language$' Commented
2146 eval.commented$ = get_evaluation_text.text$
2147 call get_evaluation_text '.language$' Level
2148 eval.level$ = get_evaluation_text.text$
2149 call get_evaluation_text '.language$' Time
2150 eval.time$ = get_evaluation_text.text$
2152 endproc
2154 # log activity
2155 procedure saveLogOfActivity .command$
2156 # Do not log in binary!
2157 if build_SHA$ = "-"
2158 createDirectory(preferencesLogDir$)
2159 appendFileLine: "'preferencesLogDir$'/'logtimeStamp$'.log", .command$
2160 endif
2161 endproc
2163 # Replay a log file with commands sgc.replaySleep inserts a pause
2164 procedure replaySGC2LogFunction
2165 if not variableExists("sgc.replaySleep")
2166 sgc.replaySleep = -1
2167 endif
2168 # Do not replay in binary!
2169 if build_SHA$ = "-"
2170 # Ask for the input file
2171 .filename$ = chooseReadFile$ ("Select file to replay")
2172 if .filename$ <> "" and fileReadable(.filename$)
2173 .replayFile = Read Strings from raw text file: .filename$
2174 if .replayFile <> undefined
2175 # Pre-pause
2176 if sgc.replaySleep > 0
2177 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 'sgc.replaySleep'
2178 Remove
2179 endif
2180 select .replayFile
2181 .numStrings = Get number of strings
2182 for .l to .numStrings
2183 select .replayFile
2184 .line$ = Get string: .l
2185 if index_regex(.line$, "process(MainPage|Config)(Help|Config|Return|Quit)")
2186 if index(.line$, "processMainPageConfig")
2187 .line$ = "call Draw_config_page"
2188 elsif index_regex(.line$, "processConfigReturn")
2189 .line$ = "call init_window"
2190 elsif index_regex(.line$, "processMainPageHelp")
2191 .line$ = "call init_window"
2192 elsif index_regex(.line$, "processConfigHelp")
2193 .line$ = "call Draw_config_page"
2194 else
2195 .line$ = "# " + .line$
2196 endif
2197 endif
2198 if index_regex(.line$, "[a-zA-Z]") > 0 and index_regex(.line$, "\s*#") <= 0
2199 # Execute
2200 '.line$'
2202 # Pause
2203 if sgc.replaySleep > 0
2204 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 'sgc.replaySleep'
2205 Remove
2206 endif
2207 endif
2208 endfor
2209 endif
2210 endif
2211 endif
2212 endproc