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