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