| blob | f1c1bbb2ef7991b5618dffa3ae4630fe730c8308 |
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 localTableDir$ = "Data"
38 buttonsTableName$ = "MainPage"
39 configTableName$ = "Config"
40 buttons$ = ""
41 config$ = ""
42 recordedSound$ = ""
43 te.recordedSound = 0
44 te.recordedPitch = 0
45 samplingFrequency = 44100
46 recordingTime = 4
48 # Pop-Up window colors
49 sgc2.popUp_bordercolor$ = "{0.5,0.5,1}"
50 sgc2.popUp_backgroundcolor$ = "{0.9,0.9,1}"
52 # If running in a packed script binary
53 if index_regex(preferencesDirectory$, "(?i'sgc2.demoAppName$')$")
54 preferencesAppDir$ = preferencesDirectory$
55 elsif index_regex(preferencesDirectory$, "[pP]raat(\-dir| Prefs)?$")
56 # If running as a Praat script, create a new preferences directory
57 if unix
58 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
59 else
60 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
61 endif
62 else
63 # It has to go somewhere. Make a subdirectory in the current preferences directory
64 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
65 endif
68 # Parameters for isolating recorded speech from noise
69 # Should be mostly left alone unless you are using ultra clean
70 # or very noisy recordings
71 noiseThresshold = -30
72 minimumPitch = 60
73 soundMargin = 0.25
74 minimumIntensity = 30
76 # Set up button height
77 buttonbevel = 0
79 # Define canvas
80 viewportMargin = 5
81 defaultFontSize = 12
82 defaultFont$ = "Helvetica"
83 defaultLineWidth = 1
85 # Set up system
86 call reset_viewport
88 # Load supporting scripts
89 # Load tables in script format
90 include CreateTables.praat
91 include CreateWordlists.praat
92 # Set up system and load preferences
93 include InitialiseSGC2.praat
94 # Include the main page buttons and procedures
95 include MainPage.praat
96 # Include the configuration page buttons and procedures
97 include Config.praat
99 # Start instruction loop
100 while demoWaitForInput()
101 .label$ = ""
102 .clickX = -1
103 .clickY = -1
104 .pressed$ = ""
105 if demoClicked()
106 .clickX = demoX()
107 .clickY = demoY()
108 call buttonClicked 'buttons$' '.clickX' '.clickY'
109 .label$ = buttonClicked.label$
110 elsif demoKeyPressed()
111 .pressed$ = demoKey$()
112 call keyPressed 'buttons$' '.pressed$'
113 .label$ = keyPressed.label$
114 endif
116 # You cannot select a text field
117 if startsWith(.label$, "$")
118 .label$ = ""
119 endif
121 # Do things
122 if .label$ != ""
123 # Push button down
124 call Draw_button 'buttons$' '.label$' 1
125 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
126 # push button up
127 call Draw_button 'buttons$' '.label$' 0
128 endif
129 endwhile
131 call end_program
134 ########################################################
135 #
136 # Definitions of procedures
137 #
138 ########################################################
139 #
140 # Do what is asked
141 procedure process_label .label$ .clickX .clickY .pressed$
142 # Log raw commands to replay in file
143 call log_command 'buttons$' '.label$' '.clickX' '.clickY' '.pressed$'
145 # Prcoess the command
146 if .label$ <> "" and not startsWith(.label$,"!")
147 .label$ = replace$(.label$, "_", " ", 0)
148 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
149 endif
150 endproc
152 # Intialize buttons
153 procedure init_buttons
154 noerase = 1
155 call Draw_all_buttons 'buttons$'
156 noerase = 0
157 endproc
159 # Draw all buttons
160 noerase = 0
161 procedure Draw_all_buttons .table$
162 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
163 select Table '.table$'
164 .numRows = Get number of rows
166 for .row to .numRows
167 .label$ = Get value... '.row' Label
168 if not startsWith(.label$, "!")
169 .pressed = 0
170 # Determine the "pressed" state of a button
171 # A variable with the same name as the button will act as a
172 # "pressed state"
173 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
174 # Simple boolean vairables
175 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
176 # True: Pressed
177 if '.variableName$' > 0
178 .pressed = 2
179 # <0: Grayed out
180 elsif '.variableName$' < 0
181 .pressed = -1
182 endif
183 # Complex buttons with an variableName+'_'+value structure
184 # varableName$ -> name of button, e.g., "language"
185 elsif index(.variableName$, "_")
186 .generalVar$ = left$(.variableName$, rindex(.variableName$, "_") - 1)
187 .currentVariableName$ = .generalVar$
188 # Is it a string?
189 if variableExists(.generalVar$+"$")
190 .currentVariableName$ = .generalVar$ + "$"
191 endif
192 # Remove one level of indirection
193 if variableExists(.currentVariableName$)
194 if index(.currentVariableName$, "$")
195 .currentVariableName$ = '.currentVariableName$'
196 else
197 .currentValue = '.currentVariableName$'
198 .currentVariableName$ = "'.currentValue'"
199 endif
200 # Remove next level of indirection
201 .currentContent$ = "'.currentVariableName$'"
202 if .currentContent$ = "_DISABLED_"
203 .pressed = -1
204 endif
205 # Reconstruct label from current values
206 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
207 # Set PRESSED from label
208 if .variableName$ = .currentLabelValue$
209 .pressed = 2
210 endif
211 endif
212 endif
213 # You did erase everything before you started here? So do not do that again
214 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
215 endif
216 endfor
217 endproc
219 # Draw a button from a predefined button table
220 # Normally, erase the area around a button
221 procedure Draw_button .table$ .label$ .push
222 call Draw_button_internal 1 '.table$' '.label$' '.push'
223 endproc
225 # Use this function if you want to control erasing
226 procedure Draw_button_internal .erase_button_area .table$ .label$ .push
227 # Scale rounding of rounded rectangles
228 .wc = 1
229 .mm = demo Horizontal wc to mm... '.wc'
230 # Allow to overide ! skip directive
231 .forceDraw = 0
232 if startsWith(.label$, "+")
233 .label$ = right$(.label$, length(.label$)-1)
234 .forceDraw = 1
235 endif
237 select Table '.table$'
238 .row = Search column... Label '.label$'
239 if .row < 1
240 call emergency_table_exit Button Table '.table$' does not have a row with label '.label$'
241 endif
243 # Perspective shift sizes
244 .shiftDown = 0
245 .shiftX = 0
246 .shiftY = 0
247 if buttonbevel <> 0
248 .shiftDown = 0.05
249 .shiftX = 0.30
250 .shiftY = 0.50
251 endif
253 # Set drawing parameters
254 .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
255 .topLineColorUp$ = "Black"
256 .topLineWidthUp = 1.5
257 .topBackGroundColorDown$ = "{0.89,0.89,0.94}"
258 .topLineColorDown$ = "{0.3,0.3,0.3}"
259 .topLineWidthDown = 1.5
260 .topBackGroundColorDisabled$ = "{0.85,0.85,0.85}"
261 .topLineColorDisabled$ = "{0.70,0.70,0.70}"
262 .topLineWidthDisabled = 1.5
263 .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
264 .flankLineColorUp$ = "{0.2,0.2,0.2}"
265 .flankLineWidthUp = 1.5
266 .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
267 .flankLineColorDown$ = .flankLineColorUp$
268 .flankLineWidthDown = 1.5
269 .buttonFontSize = defaultFontSize
271 # Get button values
272 .leftX = Get value... '.row' LeftX
273 .rightX = Get value... '.row' RightX
274 .lowY = Get value... '.row' LowY
275 .highY = Get value... '.row' HighY
276 .buttonText$ = Get value... '.row' Text
277 .buttonColor$ = Get value... '.row' Color
278 .buttonDraw$ = Get value... '.row' Draw
279 .buttonKey$ = Get value... '.row' Key
281 .rotation = 0
282 if index_regex(.buttonText$, "^![0-9\.]+!")
283 .rotation = extractNumber(.buttonText$, "!")
284 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
285 endif
287 goto NOBUTTON startsWith(.label$, "!") and not .forceDraw
289 # Replace button text with ALERT
290 if .push = 3
291 .buttonText$ = alertText$
292 endif
294 # Adapt font size to button size
295 .maxWidth = (.rightX - .leftX) - 2
296 .maxHeight = (.highY - .lowY) - 1
297 if .rotation = 0
298 # Adapt size of button to length of text if necessary
299 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
300 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
301 if adjustFontSizeOnWidth.diff > 0
302 .rightX += adjustFontSizeOnWidth.diff/2
303 .leftX -= adjustFontSizeOnWidth.diff/2
304 endif
305 call set_font_size '.buttonFontSize'
307 # Adapt size of button to length of text
308 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
309 if adjustFontSizeOnHeight.diff > 0
310 .lowY -= adjustFontSizeOnHeight.diff/2
311 .highY += adjustFontSizeOnHeight.diff/2
312 endif
313 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
314 else
315 # With non-horizontal text, only change font size
316 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
317 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
318 endif
320 # Reset and erase button area
321 call reset_viewport
322 demo Line width... 'defaultLineWidth'
323 .shiftLeftX = .leftX - .shiftX
324 .shiftRightX = .rightX
325 .shiftLowY = .lowY - .shiftY
326 .shiftHighY = .highY
327 if .erase_button_area
328 # Make erase area minutely larger
329 .eraseLeft = .shiftLeftX - 0.01
330 .eraseRight = .shiftRightX + 0.01
331 .eraseBottom = .shiftLowY - 0.01
332 .eraseTop = .shiftHighY + 0.01
333 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
334 endif
336 # If label starts with "$", it is a text field. Then do not draw the button
337 if not startsWith(.label$, "$")
338 # Give some depth to button: Draw flank outline
339 if .shiftDown or .shiftX or .shiftY
340 if .push <= 0
341 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
342 demo Colour... '.flankLineColorUp$'
343 demo Line width... '.flankLineWidthUp'
344 else
345 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
346 demo Colour... '.flankLineColorDown$'
347 demo Line width... '.flankLineWidthDown'
348 endif
349 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
350 endif
352 # Button Down will shift the top perspective
354 # Draw the button top
355 if .push = 0
356 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
357 demo Colour... '.topLineColorUp$'
358 demo Line width... '.topLineWidthUp'
359 elsif .push < 0
360 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
361 demo Colour... '.topLineColorDisabled$'
362 demo Line width... '.topLineWidthDisabled'
363 else
364 # Button Down
365 .leftX -= .shiftDown
366 .rightX -= .shiftDown
367 .lowY -= .shiftDown
368 .highY -= .shiftDown
370 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
371 demo Colour... '.topLineColorDown$'
372 demo Line width... '.topLineWidthDown'
373 endif
374 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
375 endif
377 # The button text and symbol
378 .horWC = demo Horizontal mm to wc... 10.0
379 .verWC = demo Vertical mm to wc... 10.0
380 if .verWC > 0
381 .verCoeff = .horWC / .verWC
382 else
383 .verCoeff = 1
384 endif
386 .centerX = (.leftX + .rightX)/2
387 .centerY = .lowY + 0.6*(.highY-.lowY)
388 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
389 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
390 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
391 .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
392 if .newText$ = ""
393 .newText$ = .buttonText$
394 endif
395 if .push = 1 or .push = -1
396 demo Grey
397 if .buttonColor$ = "Red"
398 .buttonColor$ = "Pink"
399 elsif .buttonColor$ = "Blue"
400 .buttonColor$ = "{0.5,0.5,1}"
401 else
402 .buttonColor$ = "Grey"
403 endif
404 elsif .push >= 2
405 .buttonColor$ = "Maroon"
406 else
407 demo Colour... Black
408 endif
410 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
411 call set_font_size '.buttonFontSize'
412 demo Colour... '.buttonColor$'
413 if .rotation = 0
414 .anchorY = .lowY
415 .verticalAlignment$ = "Bottom"
416 else
417 .anchorY = .lowY + 0.5*(.highY-.lowY)
418 .verticalAlignment$ = "Half"
419 endif
420 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
421 demoShow()
423 # Reset
424 call set_font_size 'defaultFontSize'
425 demo Black
426 demo Line width... 'defaultLineWidth'
428 label NOBUTTON
429 endproc
431 procedure set_window_title .table$ .addedText$
432 select Table '.table$'
433 .row = Search column... Label !WindowTitle
434 if .row < 1
435 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
436 endif
437 .windowText$ = Get value... '.row' Text
438 call convert_praat_to_latin1 '.windowText$'
439 .windowText$ = convert_praat_to_latin1.text$
441 demoWindowTitle(.windowText$+ .addedText$)
442 endproc
444 # Handle language setting
445 procedure processLanguageCodes .table$ .label$
446 .table$ = "Config"
447 call Draw_button 'config$' Language_'config.language$' 0
448 call Draw_button 'config$' '.label$' 2
449 # Someone might have to use more than 2 chars for the language code
450 .numChars = length(.label$) - length("Language_")
451 .lang$ = right$(.label$, .numChars)
452 # Load new tables
453 call set_language '.lang$'
454 endproc
456 # Set the language
457 procedure set_language .lang$
458 .redraw_config = 0
459 # Remove old tables
460 if buttons$ <> ""
461 select Table 'buttons$'
462 Remove
463 .redraw_config = 1
464 endif
465 if config$ <> ""
466 select Table 'config$'
467 Remove
468 .redraw_config = 1
469 endif
471 # Set language
472 call checkTable 'buttonsTableName$'_'.lang$'
473 if checkTable.available
474 config.language$ = .lang$
475 else
476 config.language$ = "EN"
477 endif
479 # Load buttons tables
480 call loadTable 'buttonsTableName$'
481 buttons$ = selected$("Table")
482 Append column... Text
483 Append column... Key
484 Append column... Helptext
485 .numLabels = Get number of rows
486 call loadTable 'buttonsTableName$'_'config.language$'
487 .buttonsLang$ = selected$("Table")
488 for .row to .numLabels
489 select Table 'buttons$'
490 .label$ = Get value... '.row' Label
491 call findLabel '.buttonsLang$' '.label$'
492 if findLabel.row > 0
493 select Table '.buttonsLang$'
494 .valueText$ = Get value... 'findLabel.row' Text
495 .valueKey$ = Get value... 'findLabel.row' Key
496 .valueHelp$ = Get value... 'findLabel.row' Helptext
497 select Table 'buttons$'
498 Set string value... '.row' Text '.valueText$'
499 Set string value... '.row' Key '.valueKey$'
500 Set string value... '.row' Helptext '.valueHelp$'
501 elsif index(.label$, "_")
502 # Load alternative language table
503 .startChar = rindex(.label$, "_")
504 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
505 call loadTable 'buttonsTableName$'_'.otherLanguage$'
506 .otherbuttonsLang$ = selected$("Table")
507 call findLabel '.otherbuttonsLang$' '.label$'
508 if findLabel.row > 0
509 select Table '.buttonsLang$'
510 .valueText$ = Get value... 'findLabel.row' Text
511 .valueKey$ = Get value... 'findLabel.row' Key
512 .valueHelp$ = Get value... 'findLabel.row' Helptext
513 select Table 'buttons$'
514 Set string value... '.row' Text '.valueText$'
515 Set string value... '.row' Key '.valueKey$'
516 Set string value... '.row' Helptext '.valueHelp$'
517 else
518 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
519 endif
520 select Table '.otherbuttonsLang$'
521 Remove
522 else
523 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
524 endif
525 endfor
526 select Table '.buttonsLang$'
527 Remove
529 # Load configuration table
530 call loadTable 'configTableName$'
531 config$ = selected$("Table")
532 Append column... Text
533 Append column... Key
534 Append column... Helptext
535 .numLabels = Get number of rows
536 call loadTable 'configTableName$'_'config.language$'
537 .configLang$ = selected$("Table")
538 for .row to .numLabels
539 select Table 'config$'
540 .label$ = Get value... '.row' Label
541 call findLabel '.configLang$' '.label$'
542 if findLabel.row > 0
543 select Table '.configLang$'
544 .valueText$ = Get value... 'findLabel.row' Text
545 .valueKey$ = Get value... 'findLabel.row' Key
546 .valueHelp$ = Get value... 'findLabel.row' Helptext
547 select Table 'config$'
548 Set string value... '.row' Text '.valueText$'
549 Set string value... '.row' Key '.valueKey$'
550 Set string value... '.row' Helptext '.valueHelp$'
551 elsif index(.label$, "_")
552 .startChar = rindex(.label$, "_")
553 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
554 call loadTable 'configTableName$'_'.otherLanguage$'
555 .otherconfigLang$ = selected$("Table")
556 call findLabel '.otherconfigLang$' '.label$'
557 if findLabel.row > 0
558 select Table '.otherconfigLang$'
559 .valueText$ = Get value... 'findLabel.row' Text
560 .valueKey$ = Get value... 'findLabel.row' Key
561 .valueHelp$ = Get value... 'findLabel.row' Helptext
562 select Table 'config$'
563 Set string value... '.row' Text '.valueText$'
564 Set string value... '.row' Key '.valueKey$'
565 Set string value... '.row' Helptext '.valueHelp$'
566 else
567 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
568 endif
569 select Table '.otherconfigLang$'
570 Remove
571 else
572 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
573 endif
574 endfor
575 select Table '.configLang$'
576 Remove
578 # Make language change visible
579 if .redraw_config
580 call Draw_config_page
581 endif
583 endproc
585 ###############################################################
586 #
587 # Button Drawing Routines
588 #
589 ###############################################################
591 # A stub for buttons that do not have a drawing routine (yet)
592 procedure DrawNull .color$ .x .y .size
593 endproc
595 procedure DrawHelp .color$ .x .y .size
596 .currentFontSize = 24
597 .y -= .size
598 .maxHeight = 2*.size
599 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
600 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
601 call set_font_size '.currentFontSize'
602 demo Colour... '.color$'
603 demo Text... '.x' Centre '.y' Bottom ?
604 call set_font_size 'defaultFontSize'
605 endproc
607 ###############################################################
608 #
609 # Button Processing Routines
610 #
611 ###############################################################
613 # Search row in table on label
614 procedure findKey .table$ .label$
615 .row = 0
616 select Table '.table$'
617 .to$ = selected$("Table")
618 .to$ = "Table_"+.to$
619 .numRows = Get number of rows
620 for .i to .numRows
621 .currentKey$ = '.to$'$[.i, "Key"]
622 if .label$ = .currentKey$
623 .row = .i
624 goto KEYFOUND
625 endif
626 endfor
627 label KEYFOUND
628 if .row <= 0 and index(.label$, "_") <= 0
629 printline "'.label$'" is not a key in '.table$'
630 endif
631 endproc
633 procedure findLabel .table$ .label$
634 .row = 0
635 select Table '.table$'
636 .to$ = selected$("Table")
637 .to$ = "Table_"+.to$
638 .numRows = Get number of rows
639 for .i to .numRows
640 .currentKey$ = '.to$'$[.i, "Label"]
641 if .label$ = .currentKey$
642 .row = .i
643 goto LABELFOUND
644 endif
645 endfor
646 label LABELFOUND
647 if .row <= 0 and index(.label$, "_") <= 0
648 call emergency_table_exit "'.label$'" is not a key in '.table$'
649 endif
650 endproc
652 # Get the label
653 procedure buttonClicked table$ .x .y
654 .label$ = ""
655 select Table 'table$'
656 .bo$ = selected$("Table")
657 .bo$ = "Table_"+.bo$
658 .numRows = Get number of rows
659 for .i to .numRows
660 if .label$ = ""
661 .leftX = '.bo$'[.i, "LeftX"]
662 .rightX = '.bo$'[.i, "RightX"]
663 .lowY = '.bo$'[.i, "LowY"]
664 .highY = '.bo$'[.i, "HighY"]
665 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
666 .label$ = '.bo$'$[.i, "Label"]
667 endif
668 endif
669 endfor
670 endproc
672 procedure keyPressed table$ .pressed$
673 .label$ = ""
674 # Magic
675 if .pressed$ = "" and not demoShiftKeyPressed()
676 .label$ = "Refresh"
677 endif
678 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
679 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
680 select Table 'table$'
681 .bo$ = selected$("Table")
682 .bo$ = "Table_"+.bo$
683 .numRows = Get number of rows
684 for .i to .numRows
685 if .label$ = ""
686 .key$ = '.bo$'$[.i, "Key"]
687 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
688 .label$ = '.bo$'$[.i, "Label"]
689 endif
690 endif
691 endfor
692 endproc
695 procedure play_sound .sound$
696 if .sound$ <> ""
697 select Sound '.sound$'
698 Play
699 endif
700 endproc
702 procedure record_sound
703 call clean_up_sound
704 if sgc2.alignedTextGrid > 0
705 select sgc2.alignedTextGrid
706 Remove
707 sgc2.alignedTextGrid = -1
708 endif
710 # There is a very nasty delay before the first recording starts, do a dummy record
711 if not variableExists("recordingInitialized")
712 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 0.1
713 Remove
714 recordingInitialized = 1
715 endif
716 # Recording light
717 demo Paint circle... Red 5 95 2
718 demoShow()
719 # In Windows interaction between demoWaitForInput and Record Sound blocks drawing the feedback
720 if windows and endsWith(build_SHA$, " XP")
721 # Display a pause window to flush the graphics buffer
722 beginPause ("DESTROY WINDOW ")
723 comment (" ")
724 endPause ("DESTROY WINDOW ", 1)
725 #call init_window
726 demo Paint circle... Red 5 95 2
727 demoShow()
728 endif
729 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 'recordingTime'
730 demo Paint circle... White 5 95 2.5
731 call wipeArea 'wipeFeedbackArea$'
733 # Feedback on recording level
734 .extremum = Get absolute extremum... 0 0 None
735 .radius = 2 * .extremum
736 if .radius <= 0
737 .radius = 0.02
738 endif
739 .blue = 0
740 .green = 0
741 .red = 0
742 if .extremum >= 0.95
743 .red = 1
744 elsif .extremum >= 0.49
745 .green = 1
746 else
747 .green = .extremum / 0.5
748 endif
749 .color$ = "{'.red','.green','.blue'}"
750 demo Colour... '.color$'
751 demo Line width... 1
752 demo Draw circle... 5 95 '.radius'
753 # Reset
754 demoShow()
755 demo Colour... Black
756 demo Line width... 'defaultLineWidth'
757 # Process sound
758 Rename... Tmp
759 Resample... 10000 50
760 Rename... Pronunciation
761 recordedSound$ = selected$("Sound")
762 te.recordedSound = selected("Sound")
763 select Sound Tmp
764 Remove
765 select Sound 'recordedSound$'
766 te.recordedSound = selected("Sound")
768 # Cut out real sound from silences/noise
769 call sound_detection 'recordedSound$' 'soundMargin'
770 select Sound 'recordedSound$'
771 te.recordedSound = selected("Sound")
772 endproc
775 # Select real sound from recording
776 # Uses some global variable
777 procedure sound_detection .sound$ .margin
778 select Sound '.sound$'
779 .soundlength = Get total duration
780 .internalSilence = 2*.margin
782 # Silence and remove noise, DANGEROUS
783 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
784 Rename... Input'.sound$'
786 select TextGrid Input'.sound$'
787 .numberofIntervals = Get number of intervals... 1
788 if .numberofIntervals < 2
789 .numberofIntervals = 0
790 endif
792 # Remove buzzing and other obnoxious sounds (if switched on)
793 for .i from 1 to .numberofIntervals
794 select TextGrid Input'.sound$'
795 .value$ = Get label of interval... 1 '.i'
796 .begintime = Get starting point... 1 '.i'
797 .endtime = Get end point... 1 '.i'
799 # Remove noise
800 if .value$ = "silent"
801 select Sound '.sound$'
802 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
803 endif
804 endfor
806 # Select target sound
807 .maximumIntensity = -1
808 .counter = 1
809 for i from 1 to .numberofIntervals
810 select TextGrid Input'.sound$'
812 .value$ = Get label of interval... 1 'i'
813 .begintime = Get starting point... 1 'i'
814 .endtime = Get end point... 1 'i'
816 if .value$ != "silent"
817 if .begintime > .margin
818 .begintime -= .margin
819 else
820 .begintime = 0
821 endif
822 if .endtime + .margin < .soundlength
823 .endtime += .margin
824 else
825 .endtime = .soundlength
826 endif
828 select Sound '.sound$'
829 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
830 Rename... Tmp'.sound$'
831 Subtract mean
832 .newIntensity = Get intensity (dB)
833 if .newIntensity > .maximumIntensity
834 if .maximumIntensity > 0
835 select Sound New'.sound$'
836 Remove
837 endif
838 select Sound Tmp'.sound$'
839 Rename... New'.sound$'
840 .maximumIntensity = .newIntensity
841 else
842 select Sound Tmp'.sound$'
843 Remove
844 endif
845 #
846 endif
847 endfor
848 if .maximumIntensity > minimumIntensity
849 select Sound '.sound$'
850 Remove
851 select Sound New'.sound$'
852 Rename... '.sound$'
853 elsif .maximumIntensity > -1
854 select Sound New'.sound$'
855 Remove
856 endif
857 select TextGrid Input'.sound$'
858 Remove
860 select Sound '.sound$'
861 endproc
863 procedure end_program
864 call write_preferences ""
865 demo Erase all
866 select all
867 Remove
868 exit
869 endproc
871 ######################################################
872 #
873 # Configuration Page
874 #
875 ######################################################
876 procedure config_page
877 demo Erase all
878 demoWindowTitle("Speak Good Chinese: Change settings")
879 .label$ = ""
880 call Draw_config_page
882 while (.label$ <> "Return") and demoWaitForInput()
883 .clickX = -1
884 .clickY = -1
885 .pressed$ = ""
886 .label$ = ""
887 if demoClicked()
888 .clickX = demoX()
889 .clickY = demoY()
890 call buttonClicked 'config$' '.clickX' '.clickY'
891 .label$ = buttonClicked.label$
892 elsif demoKeyPressed()
893 .pressed$ = demoKey$()
894 call keyPressed 'config$' '.pressed$'
895 .label$ = keyPressed.label$
896 endif
898 # You cannot select a text field
899 if startsWith(.label$, "$")
900 .label$ = ""
901 endif
903 # Do things
904 if .label$ != ""
905 # Handle push button in process_config
906 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
907 endif
909 if .label$ = "Return"
910 goto GOBACK
911 endif
912 endwhile
914 # Go back
915 label GOBACK
916 call init_window
917 endproc
919 procedure Draw_config_page
920 demo Erase all
921 # Draw background
922 if config.showBackground
923 call draw_background Background
924 endif
925 # Draw buttons
926 call Draw_all_buttons 'config$'
927 call set_window_title 'config$'
928 # Set correct buttons (alert)
929 call setConfigMainPage
930 endproc
932 # Do what is asked
933 procedure process_config .label$ .clickX .clickY .pressed$
934 if .label$ = "!Logging"
935 config.logPerformance = not config.logPerformance
936 .displayButton = config.logPerformance
937 call Draw_button 'config$' +'.label$' '.displayButton'
938 if config.logPerformance
939 call start_logging
940 endif
941 elsif .label$ <> "" and not startsWith(.label$,"!")
942 .label$ = replace$(.label$, "_", " ", 0)
943 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
944 endif
945 endproc
947 ###############################################################
948 #
949 # Presenting help texts
950 #
951 ###############################################################
953 # Process Help
954 procedure help_loop .table$ .redrawProc$
955 # General Help text
956 call write_help_title '.table$'
958 .label$ = ""
959 call Draw_button '.table$' Help 2
960 .redrawScreen = 0
961 while (.label$ <> "Help") and demoWaitForInput()
962 .label$ = ""
963 if demoClicked()
964 .clickX = demoX()
965 .clickY = demoY()
966 call buttonClicked '.table$' '.clickX' '.clickY'
967 .label$ = buttonClicked.label$
968 elsif demoKeyPressed()
969 .pressed$ = demoKey$()
970 call keyPressed '.table$' '.pressed$'
971 .label$ = keyPressed.label$
972 endif
974 if .label$ != "" and .label$ <> "Help"
975 # Redraw screen
976 if .redrawScreen
977 demo Erase all
978 call '.redrawProc$'
979 else
980 .redrawScreen = 1
981 endif
982 call Draw_button '.table$' Help 2
983 call write_help_title '.table$'
985 # Handle push button in process_config
986 call write_help_text '.table$' '.label$'
987 endif
989 endwhile
991 # Reset button
992 call Draw_button '.table$' Help 0
993 demo Erase all
994 call '.redrawProc$'
995 endproc
997 # Write help text
998 procedure write_help_text .table$ .label$
999 call findLabel '.table$' '.label$'
1000 .row = findLabel.row
1001 select Table '.table$'
1002 # Get text
1003 if .row <= 0
1004 call findLabel '.table$' Help
1005 .row = findLabel.row
1006 select Table '.table$'
1007 endif
1008 .helpText$ = Get value... '.row' Helptext
1009 .helpKey$ = Get value... '.row' Key
1010 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1011 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1012 if index_regex(.helpKey$, "\S")
1013 .helpText$ = .helpText$+" ("+.helpKey$+")"
1014 endif
1015 # Get button values
1016 .leftX = Get value... '.row' LeftX
1017 .rightX = Get value... '.row' RightX
1018 .lowY = Get value... '.row' LowY
1019 .highY = Get value... '.row' HighY
1021 # PopUp dimensions
1022 .currentHelpFontSize = defaultFontSize
1023 call set_font_size '.currentHelpFontSize'
1024 .helpTextSize = demo Text width (wc)... '.helpText$'
1025 .helpTextSize += 4
1026 if .leftX > 50
1027 .htXleft = 20
1028 .htXright = .htXleft + .helpTextSize + 5
1029 .xstart = .leftX
1030 else
1031 .htXright = 80
1032 .htXleft = .htXright - .helpTextSize - 5
1033 .xstart = .rightX
1034 endif
1035 if .lowY > 50
1036 .htYlow = 40
1037 .htYhigh = .htYlow + 7
1038 .ystart = .lowY
1039 .yend = .htYhigh
1040 else
1041 .htYhigh = 60
1042 .htYlow = .htYhigh - 7
1043 .ystart = .highY
1044 .yend = .htYlow
1045 endif
1047 # Adapt font size to horizontal dimensions
1048 .maxWidth = 90
1049 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1050 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1051 if .htXleft < 0 or .htXright > 100
1052 .htXleft = 0
1053 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1054 endif
1055 call set_font_size '.currentHelpFontSize'
1057 # Adapt vertical dimensions to font height
1058 call points_to_wc '.currentHelpFontSize'
1059 .lineHeight = points_to_wc.wc
1060 if .lineHeight > .htYhigh - .htYlow - 4
1061 .htYhigh = .htYlow + .lineHeight + 4
1062 endif
1064 # Determine arrow endpoints
1065 .xend = .htXleft
1066 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1067 .xend = .htXright
1068 endif
1069 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1070 .xend = (.htXleft+.htXright)/2
1071 endif
1073 .xtext = .htXleft + 2
1074 .ytext = .htYlow + 1
1076 # Draw pop-up
1077 .mm2wc = demo Horizontal mm to wc... 1
1078 .lineWidth = 2/.mm2wc
1079 demo Line width... '.lineWidth'
1080 demo Arrow size... '.lineWidth'
1081 demo Colour... 'sgc2.popUp_bordercolor$'
1082 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1083 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1084 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1085 demo Line width... 'defaultLineWidth'
1086 demo Arrow size... 1
1087 demo Black
1088 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1089 demoShow()
1090 call set_font_size 'defaultFontSize'
1092 endproc
1094 procedure write_help_title .table$
1095 # Set help text title
1096 # General Help text
1097 call findLabel '.table$' Help
1098 .row = findLabel.row
1099 select Table '.table$'
1100 .helpTitle$ = Get value... '.row' Helptext
1101 .helpKey$ = Get value... '.row' Key
1102 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1103 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1104 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1106 call reset_viewport
1107 .helpTitleFontSize = 14
1108 # Adapt size of button to length of text
1109 .maxWidth = 80
1110 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1111 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1112 call set_font_size '.helpTitleFontSize'
1113 .helpTop = 100
1115 demo Select inner viewport... 0 100 0 100
1116 demo Axes... 0 100 0 100
1117 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1118 call set_font_size 'defaultFontSize'
1119 call reset_viewport
1120 endproc
1122 ###############################################################
1123 #
1124 # Miscelaneous procedures
1125 #
1126 ###############################################################
1127 procedure printPageToPrinter
1128 call print_window
1129 demo Print... 'printerName$' 'printerPresets$'
1130 call init_window
1131 endproc
1133 procedure getOpenFile .openDialogue$
1134 call clean_up_sound
1136 call convert_praat_to_latin1 '.openDialogue$'
1137 .openDialogue$ = convert_praat_to_latin1.text$
1138 .filename$ = chooseReadFile$ (.openDialogue$)
1139 if .filename$ <> "" and fileReadable(.filename$)
1140 Read from file... '.filename$'
1141 call log_fileOpen '.filename$'
1143 # Get only the filename
1144 .startName = rindex_regex(.filename$, "[/\\:]") + 1
1145 .nameLength = rindex(.filename$, ".") - .startName
1146 currentSoundName$ = mid$(.filename$, .startName, .nameLength)
1147 else
1148 Create Sound from formula... Speech Mono 0 1 44100 0
1149 endif
1150 recordedSound$ = selected$("Sound")
1151 te.recordedSound = selected("Sound")
1152 currentStartTime = 0
1153 currentEndTime = Get total duration
1154 # Reset selected window
1155 selectedStartTime = currentStartTime
1156 selectedEndTime = currentEndTime
1157 endproc
1159 procedure points_to_wc .points
1160 .mm = .points * 0.3527777778
1161 .wc = demo Vertical mm to wc... '.mm'
1162 endproc
1164 procedure reset_viewport
1165 .low = viewportMargin
1166 .high = 100 - viewportMargin
1167 demo Select inner viewport... '.low' '.high' '.low' '.high'
1168 demo Axes... 0 100 0 100
1169 endproc
1171 procedure set_font_size .fontSize
1172 call reset_viewport
1173 demo Font size... '.fontSize'
1174 call reset_viewport
1175 endproc
1177 procedure wipeArea .areaCommand$
1178 call reset_viewport
1179 '.areaCommand$'
1180 endproc
1182 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1183 demo '.font$'
1184 call set_font_size '.currentFontSize'
1185 .textWidth = demo Text width (wc)... '.text$'
1186 while .textWidth > .maxWidth and .currentFontSize > 2
1187 .currentFontSize -= 0.5
1188 call set_font_size '.currentFontSize'
1189 .textWidth = demo Text width (wc)... '.text$'
1190 endwhile
1191 .diff = .textWidth - .maxWidth
1192 .newFontSize = .currentFontSize
1193 demo 'defaultFont$'
1194 endproc
1196 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1197 demo '.font$'
1198 .radians = .rotation/360 * 2 * pi
1199 .horWC = demo Horizontal mm to wc... 10.0
1200 .verWC = demo Vertical mm to wc... 10.0
1201 if .horWC > 0
1202 .verCoeff = .verWC / .horWC
1203 else
1204 .verCoeff = 1
1205 endif
1206 call set_font_size '.currentFontSize'
1207 .textLength = demo Text width (wc)... '.text$'
1208 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1209 .currentFontSize -= 0.5
1210 call set_font_size '.currentFontSize'
1211 .textLength = demo Text width (wc)... '.text$'
1212 endwhile
1213 .diff = .textLength - .maxHeight
1214 .newFontSize = .currentFontSize
1215 demo 'defaultFont$'
1216 endproc
1218 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1219 demo '.font$'
1220 call points_to_wc '.currentFontSize'
1221 .lineHeight = points_to_wc.wc
1222 while .lineHeight > .maxHeight and .currentFontSize > 2
1223 .currentFontSize -= 0.5
1224 call points_to_wc '.currentFontSize'
1225 .lineHeight = points_to_wc.wc
1226 endwhile
1227 .diff = .lineHeight - .maxHeight
1228 .newFontSize = .currentFontSize
1229 demo 'defaultFont$'
1230 endproc
1232 # Load a table with button info etc.
1233 # Load local tables if present. Else load
1234 # build-in scripted tables
1235 procedure loadTable .tableName$
1236 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1237 # Search for the table in local, preference, and global directories
1238 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1239 Read from file... 'localTableDir$'/'.tableName$'.Table
1240 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1241 Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1242 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1243 Read from file... 'globaltablelists$'/'.tableName$'.Table
1244 # Load them from script
1245 elsif variableExists("procCreate'.tableVariableName$'$")
1246 call Create'.tableVariableName$'
1247 else
1248 call write_text_popup Helvetica 14 '.tableName$' cannot be found
1249 demoWaitForInput()
1250 exit '.tableName$' cannot be found
1251 endif
1252 endproc
1254 procedure testLoadTable .tableName$
1255 .table = 0
1256 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1257 # Search for the table in local, preference, and global directories
1258 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1259 .table = 1
1260 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1261 .table = 2
1262 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1263 .table = 3
1264 # Load them from script
1265 elsif variableExists("procCreate'.tableVariableName$'$")
1266 .table = 4
1267 else
1268 .table = 0
1269 endif
1270 endproc
1272 procedure checkTable .tableName$
1273 .available = 0
1274 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1275 .available = 1
1276 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1277 .available = 1
1278 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1279 .available = 1
1280 # Load them from script
1281 elsif variableExists("procCreate'.tableName$'$")
1282 .available = 1
1283 else
1284 .available = 0
1285 endif
1286 endproc
1288 # Create a pop-up window with text from a Text Table
1289 procedure write_text_table .table$
1290 .xleft = 10
1291 .xright = 90
1292 .ylow = 20
1293 .yhigh = 85
1294 .lineHeight = 2.5
1296 # Get table with text and longest line
1297 .numLines = 0
1298 call testLoadTable '.table$'
1299 if testLoadTable.table > 0
1300 call loadTable '.table$'
1301 .instructionText = selected()
1302 .numLines = Get number of rows
1303 endif
1304 .instructionFontSize = 14
1305 .referenceText$ = ""
1306 .maxlenght = 0
1307 .maxLine = 0
1308 .maxFontSize = 0
1309 .maxWidth = 0
1310 for .l to .numLines
1311 select '.instructionText'
1312 .currentText$ = Get value... '.l' text
1313 # Expand variables, eg, 'praatVersion$'
1314 call expand_praat_variables '.currentText$'
1315 .currentText$ = expand_praat_variables.text$
1317 .font$ = Get value... '.l' font
1318 .fontSize = Get value... '.l' size
1319 call set_font_size '.fontSize'
1320 .textWidth = demo Text width (wc)... '.currentText$'
1321 if .fontSize > .maxFontSize
1322 .maxFontSize = .fontSize
1323 endif
1324 if .textWidth > .maxWidth
1325 .maxWidth = .textWidth
1326 .instructionFontSize = .fontSize
1327 .maxLine = .l
1328 endif
1329 endfor
1330 select '.instructionText'
1331 .referenceText$ = Get value... '.maxLine' text
1332 .maxLineFont$ = Get value... '.maxLine' font
1333 .instructionFontSize = Get value... '.maxLine' size
1334 call set_font_size '.maxFontSize'
1336 # Adapt size of button to length of text
1337 .maxWidth = (.xright - .xleft) - 4
1338 .origFontSize = .instructionFontSize
1339 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1340 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1341 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1342 if adjustFontSizeOnWidth.diff > 0
1343 .xright += adjustFontSizeOnWidth.diff/4
1344 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1345 endif
1346 call set_font_size '.instructionFontSize'
1347 .fontSizeFactor = .instructionFontSize / .origFontSize
1349 .numRows = Get number of rows
1350 # Calculate length from number of lines.
1351 .dy = .lineHeight
1352 .midY = .yhigh - (.yhigh - .ylow)/2
1353 .yhigh = .midY + (.numRows+1) * .dy / 2
1354 .ylow = .yhigh - (.numRows+1) * .dy
1355 .textleft = .xleft + 2
1357 demo Line width... 8
1358 demo Colour... 'sgc2.popUp_bordercolor$'
1359 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1360 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1361 demo Line width... 'defaultLineWidth'
1362 demo Black
1363 .ytext = .yhigh - 2 - .dy
1364 for .i to .numRows
1365 select '.instructionText'
1366 .font$ = Get value... '.i' font
1367 .fontSize = Get value... '.i' size
1368 .font$ = extractWord$(.font$, "")
1369 # Scale font
1370 .fontSize = floor(.fontSize*.fontSizeFactor)
1371 if .fontSize < 4
1372 .fontSize = 4
1373 endif
1374 .line$ = Get value... '.i' text
1375 # Expand variables, eg, 'praatVersion$'
1376 call expand_praat_variables '.line$'
1377 .line$ = expand_praat_variables.text$
1379 # Display text
1380 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1381 .ytext -= .dy
1382 endfor
1383 demoShow()
1384 call set_font_size 'defaultFontSize'
1386 select '.instructionText'
1387 Remove
1389 label ESCAPEwrite_text_table
1390 endproc
1393 # Create a pop-up window with text from an existing Table object
1394 procedure write_tabbed_table .table$ .labelTextTable$
1395 .xleft = 0
1396 .xright = 100
1397 .ylow = 20
1398 .yhigh = 85
1399 .lineHeight = 2.5
1401 # Get table with text and longest line
1402 call testLoadTable '.table$'
1403 if testLoadTable.table <= 0
1404 call loadTable '.labelTextTable$'
1405 .labelText$ = selected$("Table")
1406 endif
1408 select Table '.table$'
1409 .tabbedText = selected()
1410 .numLines = Get number of rows
1411 .numCols = Get number of columns
1412 .font$ = defaultFont$
1413 .fontSize = defaultFontSize
1414 # Standard width
1415 .widthCanvas = .xright - .xleft
1416 .dx = (.widthCanvas - 4) / (.numCols)
1418 # Get longest entry
1419 demo '.font$'
1420 call set_font_size '.fontSize'
1421 .maxWidth = 0
1422 for .i from 0 to .numLines
1423 .xtext = .xleft + .dx / 2
1424 for .j to .numCols
1425 select '.tabbedText'
1426 .currentLabel$ = Get column label... '.j'
1427 if .i > 0
1428 .line$ = Get value... '.i' '.currentLabel$'
1429 else
1430 .line$ = .currentLabel$
1431 select Table '.labelText$'
1432 call findLabel '.labelText$' '.line$'
1433 select Table '.labelText$'
1434 .line$ = Get value... 'findLabel.row' Text
1435 endif
1436 # Expand variables, eg, 'praatVersion$'
1437 call expand_praat_variables '.line$'
1438 .line$ = expand_praat_variables.text$
1439 .textWidth = demo Text width (wc)... '.line$'
1440 if .textWidth > .maxWidth
1441 .maxWidth = .textWidth
1442 endif
1443 endfor
1444 endfor
1445 if .dx > 1.2 * .maxWidth
1446 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1447 .xleft = 50 - .widthCanvas / 2
1448 .xright = 50 + .widthCanvas / 2
1449 .dx = (.widthCanvas - 4) / (.numCols)
1450 else
1451 .maxWidth = .dx - 1
1452 endif
1454 # Calculate length from number of lines.
1455 .dy = .lineHeight + 0.5
1456 .midY = .yhigh - (.yhigh - .ylow)/2
1457 .yhigh = .midY + (.numLines+2) * .dy / 2
1458 .ylow = .yhigh - (.numLines+2) * .dy
1459 .textleft = .xleft + 2
1461 demo Line width... 8
1462 demo Colour... 'sgc2.popUp_bordercolor$'
1463 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1464 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1465 demo Line width... 'defaultLineWidth'
1466 demo Black
1467 .ytext = .yhigh - 2 - .dy
1468 # First the column names, then the items
1469 for .i from 0 to .numLines
1470 .xtext = .textleft + .dx / 2
1471 for .j to .numCols
1472 select '.tabbedText'
1473 .currentLabel$ = Get column label... '.j'
1474 if .i > 0
1475 .line$ = Get value... '.i' '.currentLabel$'
1476 else
1477 .line$ = .currentLabel$
1478 select Table '.labelText$'
1479 call findLabel '.labelText$' '.line$'
1480 select Table '.labelText$'
1481 .line$ = Get value... 'findLabel.row' Text
1482 endif
1483 # Expand variables, eg, 'praatVersion$'
1484 call expand_praat_variables '.line$'
1485 .line$ = expand_praat_variables.text$
1486 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1487 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1489 # Display text
1490 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1491 .xtext += .dx
1492 endfor
1493 .ytext -= .dy
1494 endfor
1495 demoShow()
1496 call set_font_size 'defaultFontSize'
1497 select Table '.labelText$'
1498 Remove
1500 label ESCAPEwrite_tabbed_table
1501 endproc
1503 # Create a pop-up window with a given text
1504 procedure write_text_popup .font$ .size .text$
1505 .xleft = 10
1506 .xright = 90
1507 .ylow = 20
1508 .yhigh = 85
1509 .lineHeight = 3
1511 # Adapt size of button to length of text
1512 .maxWidth = (.xright - .xleft) - 4
1513 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1514 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1515 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1516 if adjustFontSizeOnWidth.diff > 0
1517 .xright += adjustFontSizeOnWidth.diff/4
1518 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1519 else
1520 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1521 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1522 endif
1524 .numRows = 1
1525 # Calculate length from number of lines.
1526 .dy = .lineHeight
1527 .midY = .yhigh - (.yhigh - .ylow)/2
1528 .yhigh = .midY + (.numRows+1) * .dy / 2
1529 .ylow = .yhigh - (.numRows+1) * .dy
1530 .textleft = .xleft + 2
1531 .xmid = (.textleft + .xright - 2)/2
1533 demo Line width... 8
1534 demo Colour... 'sgc2.popUp_bordercolor$'
1535 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1536 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1537 demo Line width... 'defaultLineWidth'
1538 demo Black
1539 .ytext = .yhigh - 2 - .dy
1540 # Write text
1541 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1543 demoShow()
1544 demo 'defaultFont$'
1545 call set_font_size 'defaultFontSize'
1546 endproc
1548 # Write the background from a Text Table
1549 procedure draw_background .table$
1550 .xleft = 0
1551 .xright = 100
1552 .ylow = 0
1553 .yhigh = 100
1554 .lineHeight = 5
1555 .defaultColour$ = "{0.9,0.9,0.9}"
1556 .defaultAlign$ = "centre"
1558 # Get table with text and longest line
1559 call loadTable '.table$'
1560 .backgroundText = selected()
1561 .numLines = Get number of rows
1562 .backgroundFontSize = 28
1563 .referenceText$ = ""
1564 .maxlenght = 0
1565 .maxLine = 0
1566 .maxFontSize = 0
1567 .maxWidth = 0
1568 .textLines = 0
1569 for .l to .numLines
1570 select '.backgroundText'
1571 .currentText$ = Get value... '.l' text
1572 # Expand variables, eg, 'praatVersion$'
1573 call expand_praat_variables '.currentText$'
1574 .currentText$ = expand_praat_variables.text$
1576 .font$ = Get value... '.l' font
1577 .fontSize = Get value... '.l' size
1578 if .fontSize > .maxFontSize
1579 .maxFontSize = .fontSize
1580 endif
1581 if not startsWith(.font$, "!")
1582 call set_font_size '.fontSize'
1583 .textWidth = demo Text width (wc)... '.currentText$'
1584 if .textWidth > .maxWidth
1585 .maxWidth = .textWidth
1586 .backgroundFontSize = .fontSize
1587 .maxLine = .l
1588 endif
1590 .textLines += 1
1591 endif
1592 endfor
1593 if .maxLine > 0
1594 select '.backgroundText'
1595 .referenceText$ = Get value... '.maxLine' text
1596 .maxLineFont$ = Get value... '.maxLine' font
1597 .backgroundFontSize = Get value... '.maxLine' size
1598 .backgroundFontColour$ = Get value... '.maxLine' colour
1599 call set_font_size '.maxFontSize'
1600 else
1601 .maxFontSize = .backgroundFontSize
1602 endif
1604 # Adapt size of button to length of text
1605 .maxWidth = (.xright - .xleft) - 4
1606 .origFontSize = .backgroundFontSize
1607 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1608 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1609 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1610 call set_font_size '.backgroundFontSize'
1612 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1613 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1614 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1615 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1616 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1617 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1618 endif
1620 .numRows = Get number of rows
1621 # Calculate length from number of lines.
1622 .dy = .lineHeight
1623 .midY = .yhigh - (.yhigh - .ylow)/2
1624 .yhigh = .midY + (.textLines+1) * .dy / 2
1625 .ylow = .yhigh - (.textLines+1) * .dy
1626 .textleft = .xleft + 2
1627 .textright = .xright - 2
1628 .textmid = (.xright - .xleft)/2
1630 demo Black
1631 .ytext = .yhigh - 2 - .dy
1632 for .i to .numRows
1633 select '.backgroundText'
1634 .font$ = Get value... '.i' font
1635 .fontSize = Get value... '.i' size
1636 .fontColour$ = Get value... '.i' colour
1637 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1638 .fontAlign$ = Get value... '.i' align
1639 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1640 .line$ = Get value... '.i' text
1641 # Expand variables, eg, 'praatVersion$'
1642 call expand_praat_variables '.line$'
1643 .line$ = expand_praat_variables.text$
1645 # Scale font
1646 .fontSize = floor(.fontSize*.fontSizeFactor)
1647 if not startsWith(.font$, "!")
1648 .font$ = extractWord$(.font$, "")
1650 if .fontAlign$ = "centre"
1651 .xtext = .textmid
1652 elsif .fontAlign$ = "right"
1653 .xtext = .textright
1654 else
1655 .xtext = .textleft
1656 endif
1657 if .fontSize < 4
1658 .fontSize = 4
1659 endif
1660 # Clean up text
1661 demo Colour... '.fontColour$'
1662 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1663 .ytext -= .dy
1664 elsif .font$ = "!demo command"
1665 demo Colour... '.fontColour$'
1666 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1667 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1668 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1669 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1670 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1671 while index(.line$, "[[")
1672 .nextBracketOpen = index(.line$, "[[")
1673 .nextBracketOpen += 2
1674 .nextBracketClose = index(.line$, "]]")
1675 .bracketLength = .nextBracketClose - .nextBracketOpen
1676 .result$ = ""
1677 if .bracketLength > 0
1678 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1679 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1680 if length(.expression$) > 0
1681 # Test expression for security, only allow explicitely defined functions
1682 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1683 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1684 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1685 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1686 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1687 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1688 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1689 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1690 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1691 if .testExpression$ = ""
1692 .calc = '.expression$'
1693 .result$ = "'.calc'"
1694 endif
1695 endif
1696 endif
1698 # Replace expression by result
1699 .lastLeft = .nextBracketOpen - 3
1700 .newLine$ = left$(.line$, .lastLeft)
1701 .newLine$ = .newLine$ + .result$
1702 .numCopy = length(.line$) - .nextBracketClose - 1
1703 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1704 .line$ = .newLine$
1705 endwhile
1706 demo '.line$'
1707 endif
1708 endfor
1709 demo Black
1710 demoShow()
1711 call set_font_size 'defaultFontSize'
1713 select '.backgroundText'
1714 Remove
1715 endproc
1717 procedure convert_praat_to_utf8 .text$
1718 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1719 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1720 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1721 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1722 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1723 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1724 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1725 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1726 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1727 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1728 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1729 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1730 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1731 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1732 endproc
1734 procedure convert_praat_to_latin1 .text$
1735 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1736 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1737 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1738 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1739 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1740 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1741 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1742 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1743 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1744 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1745 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1746 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1747 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1748 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1749 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1750 endproc
1752 # Expand 'variable$' into the value of variable$.
1753 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1754 # Single quotes can be protected by \'
1755 procedure expand_praat_variables .text$
1756 if index(.text$, "'")
1757 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1758 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1759 .tempText$ = """"+.tempText$+""""
1760 # Check whether all the variables actually exist. Ignore any variable that does not exist
1761 .checkVars$ = .tempText$
1762 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1763 .start = index(.checkVars$, "+")
1764 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1765 .end = index(.checkVars$, "+")
1766 if .end
1767 .variable$ = left$(.checkVars$, .end - 1)
1768 if not variableExists(.variable$)
1769 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1770 endif
1771 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1772 else
1773 .checkVars$ = ""
1774 endif
1775 endwhile
1776 .text$ = '.tempText$'
1777 endif
1778 endproc
1780 # Get a time stamp in normalized format
1781 procedure getTimeStamp
1782 .currentDateTime$ = date$()
1783 .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)
1784 endproc
1786 # A table error, can be insiduously caused by an outdate preferences file!
1787 procedure emergency_table_exit .message$
1788 # If you come here as a user, your preferences file is borked
1789 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
1790 deleteFile(preferencesAppFile$)
1791 endif
1792 exit '.message$'
1793 endproc
1795 # Remove previous files from system
1796 procedure clean_up_sound
1797 if recordedSound$ = ""
1798 te.recordedSound = 0
1799 endif
1800 if te.recordedSound > 0
1801 select te.recordedSound
1802 Remove
1803 recordedSound$ = ""
1804 te.recordedSound = 0
1805 endif
1806 if te.recordedPitch > 0
1807 select te.recordedPitch
1808 Remove
1809 te.recordedPitch = 0
1810 endif
1811 endproc