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