| blob | 2b82d733caece704bc64b4f03ed1d796cecac755 |
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$ = "Sgc2"
31 # Define variable that might be reset in Initialise*.praat
32 # These are simply "useful" defaults
33 localTableDir$ = "Data"
34 buttonsTableName$ = "MainPage"
35 configTableName$ = "Config"
36 buttons$ = ""
37 config$ = ""
38 recordedSound$ = ""
39 samplingFrequency = 44100
40 recordingTime = 4
42 # If running in a packed script binary
43 if endsWith(preferencesDirectory$, sgc2.demoAppName$)
44 preferencesAppDir$ = preferencesDirectory$
45 elsif index_regex(preferencesDirectory$, "[pP]raat(\-dir| Prefs)?$")
46 # If running as a Praat script, create a new preferences directory
47 if unix
48 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
49 else
50 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
51 endif
52 else
53 # It has to go somewhere. Make a subdirectory in the current preferences directory
54 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
55 endif
58 # Parameters for isolating recorded speech from noise
59 # Should be mostly left alone unless you are using ultra clean
60 # or very noisy recordings
61 noiseThresshold = -30
62 minimumPitch = 60
63 soundMargin = 0.25
64 minimumIntensity = 30
66 # Set up button height
67 buttonbevel = 0
69 # Define canvas
70 viewportMargin = 5
71 defaultFontSize = 12
72 defaultFont$ = "Helvetica"
73 defaultLineWidth = 1
75 # Set up system
76 call reset_viewport
78 # Load supporting scripts
79 # Set up system and load preferences
80 include InitialiseSGC2.praat
81 # Include the main page buttons and procedures
82 include MainPage.praat
83 # Include the configuration page buttons and procedures
84 include Config.praat
85 # Load tables in script format
86 include CreateTables.praat
87 include CreateWordlists.praat
89 # Start instruction loop
90 while demoWaitForInput()
91 .label$ = ""
92 .clickX = -1
93 .clickY = -1
94 .pressed$ = ""
95 if demoClicked()
96 .clickX = demoX()
97 .clickY = demoY()
98 call buttonClicked 'buttons$' '.clickX' '.clickY'
99 .label$ = buttonClicked.label$
100 elsif demoKeyPressed()
101 .pressed$ = demoKey$()
102 call keyPressed 'buttons$' '.pressed$'
103 .label$ = keyPressed.label$
104 endif
106 # You cannot select a text field
107 if startsWith(.label$, "$")
108 .label$ = ""
109 endif
111 # Do things
112 if .label$ != ""
113 # Push button down
114 call Draw_button 'buttons$' '.label$' 1
115 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
116 # push button up
117 call Draw_button 'buttons$' '.label$' 0
118 endif
119 endwhile
121 call end_program
124 ########################################################
125 #
126 # Definitions of procedures
127 #
128 ########################################################
129 #
130 # Do what is asked
131 procedure process_label .label$ .clickX .clickY .pressed$
132 if .label$ <> "" and not startsWith(.label$,"!")
133 .label$ = replace$(.label$, "_", " ", 0)
134 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
135 endif
136 endproc
138 # Intialize buttons
139 procedure init_buttons
140 noerase = 1
141 call Draw_all_buttons 'buttons$'
142 noerase = 0
143 endproc
145 # Draw all buttons
146 noerase = 0
147 procedure Draw_all_buttons .table$
148 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
149 select Table '.table$'
150 .numRows = Get number of rows
152 for .row to .numRows
153 .label$ = Get value... '.row' Label
154 if not startsWith(.label$, "!")
155 .pressed = 0
156 # Determine the "pressed" state of a button
157 # A variable with the same name as the button will act as a
158 # "pressed state"
159 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
160 # Simple boolean vairables
161 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
162 # True: Pressed
163 if '.variableName$' > 0
164 .pressed = 2
165 # <0: Grayed out
166 elsif '.variableName$' < 0
167 .pressed = -1
168 endif
169 # Complex buttons with an variableName+'_'+value structure
170 # varableName$ -> name of button, e.g., "language"
171 elsif index(.variableName$, "_")
172 .generalVar$ = left$(.variableName$, rindex(.variableName$, "_") - 1)
173 .currentVariableName$ = .generalVar$
174 # Is it a string?
175 if variableExists(.generalVar$+"$")
176 .currentVariableName$ = .generalVar$ + "$"
177 endif
178 # Remove one level of indirection
179 if variableExists(.currentVariableName$)
180 if index(.currentVariableName$, "$")
181 .currentVariableName$ = '.currentVariableName$'
182 else
183 .currentValue = '.currentVariableName$'
184 .currentVariableName$ = "'.currentValue'"
185 endif
186 # Remove next level of indirection
187 .currentContent$ = "'.currentVariableName$'"
188 if .currentContent$ = "_DISABLED_"
189 .pressed = -1
190 endif
191 # Reconstruct label from current values
192 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
193 # Set PRESSED from label
194 if .variableName$ = .currentLabelValue$
195 .pressed = 2
196 endif
197 endif
198 endif
199 # You did erase everything before you started here? So do not do that again
200 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
201 endif
202 endfor
203 endproc
205 # Draw a button from a predefined button table
206 # Normally, erase the area around a button
207 procedure Draw_button .table$ .label$ .push
208 call Draw_button_internal 1 '.table$' '.label$' '.push'
209 endproc
211 # Use this function if you want to control erasing
212 procedure Draw_button_internal .erase_button_area .table$ .label$ .push
213 # Scale rounding of rounded rectangles
214 .wc = 1
215 .mm = demo Horizontal wc to mm... '.wc'
216 # Allow to overide ! skip directive
217 .forceDraw = 0
218 if startsWith(.label$, "+")
219 .label$ = right$(.label$, length(.label$)-1)
220 .forceDraw = 1
221 endif
223 select Table '.table$'
224 .row = Search column... Label '.label$'
225 if .row < 1
226 exit Button Table '.table$' does not have a row with label '.label$'
227 endif
229 # Perspective shift sizes
230 .shiftDown = 0
231 .shiftX = 0
232 .shiftY = 0
233 if buttonbevel <> 0
234 .shiftDown = 0.05
235 .shiftX = 0.30
236 .shiftY = 0.50
237 endif
239 # Set drawing parameters
240 .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
241 .topLineColorUp$ = "Black"
242 .topLineWidthUp = 1.5
243 .topBackGroundColorDown$ = "{0.89,0.89,0.94}"
244 .topLineColorDown$ = "{0.3,0.3,0.3}"
245 .topLineWidthDown = 1.5
246 .topBackGroundColorDisabled$ = "{0.85,0.85,0.85}"
247 .topLineColorDisabled$ = "{0.70,0.70,0.70}"
248 .topLineWidthDisabled = 1.5
249 .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
250 .flankLineColorUp$ = "{0.2,0.2,0.2}"
251 .flankLineWidthUp = 1.5
252 .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
253 .flankLineColorDown$ = .flankLineColorUp$
254 .flankLineWidthDown = 1.5
255 .buttonFontSize = defaultFontSize
257 # Get button values
258 .leftX = Get value... '.row' LeftX
259 .rightX = Get value... '.row' RightX
260 .lowY = Get value... '.row' LowY
261 .highY = Get value... '.row' HighY
262 .buttonText$ = Get value... '.row' Text
263 .buttonColor$ = Get value... '.row' Color
264 .buttonDraw$ = Get value... '.row' Draw
265 .buttonKey$ = Get value... '.row' Key
267 .rotation = 0
268 if index_regex(.buttonText$, "^![0-9\.]+!")
269 .rotation = extractNumber(.buttonText$, "!")
270 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
271 endif
273 goto NOBUTTON startsWith(.label$, "!") and not .forceDraw
275 # Replace button text with ALERT
276 if .push = 3
277 .buttonText$ = alertText$
278 endif
280 # Adapt font size to button size
281 .maxWidth = (.rightX - .leftX) - 2
282 .maxHeight = (.highY - .lowY) - 1
283 if .rotation = 0
284 # Adapt size of button to length of text if necessary
285 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
286 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
287 if adjustFontSizeOnWidth.diff > 0
288 .rightX += adjustFontSizeOnWidth.diff/2
289 .leftX -= adjustFontSizeOnWidth.diff/2
290 endif
291 call set_font_size '.buttonFontSize'
293 # Adapt size of button to length of text
294 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
295 if adjustFontSizeOnHeight.diff > 0
296 .lowY -= adjustFontSizeOnHeight.diff/2
297 .highY += adjustFontSizeOnHeight.diff/2
298 endif
299 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
300 else
301 # With non-horizontal text, only change font size
302 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
303 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
304 endif
306 # Reset and erase button area
307 call reset_viewport
308 demo Line width... 'defaultLineWidth'
309 .shiftLeftX = .leftX - .shiftX
310 .shiftRightX = .rightX
311 .shiftLowY = .lowY - .shiftY
312 .shiftHighY = .highY
313 if .erase_button_area
314 # Make erase area minutely larger
315 .eraseLeft = .shiftLeftX - 0.01
316 .eraseRight = .shiftRightX + 0.01
317 .eraseBottom = .shiftLowY - 0.01
318 .eraseTop = .shiftHighY + 0.01
319 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
320 endif
322 # If label starts with "$", it is a text field. Then do not draw the button
323 if not startsWith(.label$, "$")
324 # Give some depth to button: Draw flank outline
325 if .shiftDown or .shiftX or .shiftY
326 if .push <= 0
327 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
328 demo Colour... '.flankLineColorUp$'
329 demo Line width... '.flankLineWidthUp'
330 else
331 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
332 demo Colour... '.flankLineColorDown$'
333 demo Line width... '.flankLineWidthDown'
334 endif
335 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
336 endif
338 # Button Down will shift the top perspective
340 # Draw the button top
341 if .push = 0
342 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
343 demo Colour... '.topLineColorUp$'
344 demo Line width... '.topLineWidthUp'
345 elsif .push < 0
346 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
347 demo Colour... '.topLineColorDisabled$'
348 demo Line width... '.topLineWidthDisabled'
349 else
350 # Button Down
351 .leftX -= .shiftDown
352 .rightX -= .shiftDown
353 .lowY -= .shiftDown
354 .highY -= .shiftDown
356 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
357 demo Colour... '.topLineColorDown$'
358 demo Line width... '.topLineWidthDown'
359 endif
360 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
361 endif
363 # The button text and symbol
364 .horWC = demo Horizontal mm to wc... 10.0
365 .verWC = demo Vertical mm to wc... 10.0
366 if .verWC > 0
367 .verCoeff = .horWC / .verWC
368 else
369 .verCoeff = 1
370 endif
372 .centerX = (.leftX + .rightX)/2
373 .centerY = .lowY + 0.6*(.highY-.lowY)
374 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
375 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
376 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
377 .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
378 if .newText$ = ""
379 .newText$ = .buttonText$
380 endif
381 if .push = 1 or .push = -1
382 demo Grey
383 if .buttonColor$ = "Red"
384 .buttonColor$ = "Pink"
385 elsif .buttonColor$ = "Blue"
386 .buttonColor$ = "{0.5,0.5,1}"
387 else
388 .buttonColor$ = "Grey"
389 endif
390 elsif .push >= 2
391 .buttonColor$ = "Maroon"
392 else
393 demo Colour... Black
394 endif
396 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
397 call set_font_size '.buttonFontSize'
398 demo Colour... '.buttonColor$'
399 if .rotation = 0
400 .anchorY = .lowY
401 .verticalAlignment$ = "Bottom"
402 else
403 .anchorY = .lowY + 0.5*(.highY-.lowY)
404 .verticalAlignment$ = "Half"
405 endif
406 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
407 demoShow()
409 # Reset
410 call set_font_size 'defaultFontSize'
411 demo Black
412 demo Line width... 'defaultLineWidth'
414 label NOBUTTON
415 endproc
417 procedure set_window_title .table$ .addedText$
418 select Table '.table$'
419 .row = Search column... Label !WindowTitle
420 if .row < 1
421 exit Button Table '.table$' does not have a row with label !WindowTitle
422 endif
423 .windowText$ = Get value... '.row' Text
424 call convert_praat_to_utf8 '.windowText$'
425 .windowText$ = convert_praat_to_utf8.text$
427 demoWindowTitle(.windowText$+ .addedText$)
428 endproc
430 # Handle language setting
431 procedure processLanguageCodes .table$ .label$
432 .table$ = "Config"
433 call Draw_button 'config$' Language_'config.language$' 0
434 call Draw_button 'config$' '.label$' 2
435 # Someone might have to use more than 2 chars for the language code
436 .numChars = length(.label$) - length("Language_")
437 .lang$ = right$(.label$, .numChars)
438 # Load new tables
439 call set_language '.lang$'
440 endproc
442 # Set the language
443 procedure set_language .lang$
444 .redraw_config = 0
445 # Remove old tables
446 if buttons$ <> ""
447 select Table 'buttons$'
448 Remove
449 .redraw_config = 1
450 endif
451 if config$ <> ""
452 select Table 'config$'
453 Remove
454 .redraw_config = 1
455 endif
457 # Set language
458 config.language$ = .lang$
460 # Load buttons tables
461 call loadTable 'buttonsTableName$'
462 buttons$ = selected$("Table")
463 Append column... Text
464 Append column... Key
465 Append column... Helptext
466 .numLabels = Get number of rows
467 call loadTable 'buttonsTableName$'_'config.language$'
468 .buttonsLang$ = selected$("Table")
469 for .row to .numLabels
470 select Table 'buttons$'
471 .label$ = Get value... '.row' Label
472 call findLabel '.buttonsLang$' '.label$'
473 if findLabel.row > 0
474 select Table '.buttonsLang$'
475 .valueText$ = Get value... 'findLabel.row' Text
476 .valueKey$ = Get value... 'findLabel.row' Key
477 .valueHelp$ = Get value... 'findLabel.row' Helptext
478 select Table 'buttons$'
479 Set string value... '.row' Text '.valueText$'
480 Set string value... '.row' Key '.valueKey$'
481 Set string value... '.row' Helptext '.valueHelp$'
482 elsif index(.label$, "_")
483 # Load alternative language table
484 .startChar = rindex(.label$, "_")
485 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
486 call loadTable 'buttonsTableName$'_'.otherLanguage$'
487 .otherbuttonsLang$ = selected$("Table")
488 call findLabel '.otherbuttonsLang$' '.label$'
489 if findLabel.row > 0
490 select Table '.buttonsLang$'
491 .valueText$ = Get value... 'findLabel.row' Text
492 .valueKey$ = Get value... 'findLabel.row' Key
493 .valueHelp$ = Get value... 'findLabel.row' Helptext
494 select Table 'buttons$'
495 Set string value... '.row' Text '.valueText$'
496 Set string value... '.row' Key '.valueKey$'
497 Set string value... '.row' Helptext '.valueHelp$'
498 else
499 exit Cannot find Label: '.otherbuttonsLang$' '.label$'
500 endif
501 select Table '.otherbuttonsLang$'
502 Remove
503 else
504 exit Cannot find Label: '.buttonsLang$' '.label$'
505 endif
506 endfor
507 select Table '.buttonsLang$'
508 Remove
510 # Load configuration table
511 call loadTable 'configTableName$'
512 config$ = selected$("Table")
513 Append column... Text
514 Append column... Key
515 Append column... Helptext
516 .numLabels = Get number of rows
517 call loadTable 'configTableName$'_'config.language$'
518 .configLang$ = selected$("Table")
519 for .row to .numLabels
520 select Table 'config$'
521 .label$ = Get value... '.row' Label
522 call findLabel '.configLang$' '.label$'
523 if findLabel.row > 0
524 select Table '.configLang$'
525 .valueText$ = Get value... 'findLabel.row' Text
526 .valueKey$ = Get value... 'findLabel.row' Key
527 .valueHelp$ = Get value... 'findLabel.row' Helptext
528 select Table 'config$'
529 Set string value... '.row' Text '.valueText$'
530 Set string value... '.row' Key '.valueKey$'
531 Set string value... '.row' Helptext '.valueHelp$'
532 elsif index(.label$, "_")
533 .startChar = rindex(.label$, "_")
534 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
535 call loadTable 'configTableName$'_'.otherLanguage$'
536 .otherconfigLang$ = selected$("Table")
537 call findLabel '.otherconfigLang$' '.label$'
538 if findLabel.row > 0
539 select Table '.otherconfigLang$'
540 .valueText$ = Get value... 'findLabel.row' Text
541 .valueKey$ = Get value... 'findLabel.row' Key
542 .valueHelp$ = Get value... 'findLabel.row' Helptext
543 select Table 'config$'
544 Set string value... '.row' Text '.valueText$'
545 Set string value... '.row' Key '.valueKey$'
546 Set string value... '.row' Helptext '.valueHelp$'
547 else
548 exit Cannot find Label: '.otherconfigLang$' '.label$'
549 endif
550 select Table '.otherconfigLang$'
551 Remove
552 else
553 exit Cannot find Label: '.configLang$' '.label$'
554 endif
555 endfor
556 select Table '.configLang$'
557 Remove
559 # Make language change visible
560 if .redraw_config
561 call Draw_config_page
562 endif
564 endproc
566 ###############################################################
567 #
568 # Button Drawing Routines
569 #
570 ###############################################################
572 # A stub for buttons that do not have a drawing routine (yet)
573 procedure DrawNull .color$ .x .y .size
574 endproc
576 procedure DrawHelp .color$ .x .y .size
577 .currentFontSize = 24
578 .y -= .size
579 .maxHeight = 2*.size
580 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
581 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
582 call set_font_size '.currentFontSize'
583 demo Colour... '.color$'
584 demo Text... '.x' Centre '.y' Bottom ?
585 call set_font_size 'defaultFontSize'
586 endproc
588 ###############################################################
589 #
590 # Button Processing Routines
591 #
592 ###############################################################
594 # Search row in table on label
595 procedure findKey .table$ .label$
596 .row = 0
597 select Table '.table$'
598 .to$ = selected$("Table")
599 .to$ = "Table_"+.to$
600 .numRows = Get number of rows
601 for .i to .numRows
602 .currentKey$ = '.to$'$[.i, "Key"]
603 if .label$ = .currentKey$
604 .row = .i
605 goto KEYFOUND
606 endif
607 endfor
608 label KEYFOUND
609 if .row <= 0 and index(.label$, "_") <= 0
610 printline "'.label$'" is not a key in '.table$'
611 endif
612 endproc
614 procedure findLabel .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, "Label"]
622 if .label$ = .currentKey$
623 .row = .i
624 goto LABELFOUND
625 endif
626 endfor
627 label LABELFOUND
628 if .row <= 0 and index(.label$, "_") <= 0
629 exit "'.label$'" is not a key in '.table$'
630 endif
631 endproc
633 # Get the label
634 procedure buttonClicked table$ .x .y
635 .label$ = ""
636 select Table 'table$'
637 .bo$ = selected$("Table")
638 .bo$ = "Table_"+.bo$
639 .numRows = Get number of rows
640 for .i to .numRows
641 if .label$ = ""
642 .leftX = '.bo$'[.i, "LeftX"]
643 .rightX = '.bo$'[.i, "RightX"]
644 .lowY = '.bo$'[.i, "LowY"]
645 .highY = '.bo$'[.i, "HighY"]
646 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
647 .label$ = '.bo$'$[.i, "Label"]
648 endif
649 endif
650 endfor
651 endproc
653 procedure keyPressed table$ .pressed$
654 .label$ = ""
655 # Magic
656 if .pressed$ = "" and not demoShiftKeyPressed()
657 .label$ = "Refresh"
658 endif
659 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
660 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
661 select Table 'table$'
662 .bo$ = selected$("Table")
663 .bo$ = "Table_"+.bo$
664 .numRows = Get number of rows
665 for .i to .numRows
666 if .label$ = ""
667 .key$ = '.bo$'$[.i, "Key"]
668 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
669 .label$ = '.bo$'$[.i, "Label"]
670 endif
671 endif
672 endfor
673 endproc
676 procedure play_sound .sound$
677 if .sound$ <> ""
678 select Sound '.sound$'
679 Play
680 endif
681 endproc
683 procedure record_sound
684 if recordedSound$ != ""
685 select Sound 'recordedSound$'
686 Remove
687 recordedSound$ = ""
688 endif
689 # Recording light
690 demo Paint circle... Red 5 95 2
691 demoShow()
692 nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 'recordingTime'
693 demo Paint circle... White 5 95 2.5
694 call wipeArea 'wipeFeedbackArea$'
696 # Feedback on recording level
697 .extremum = Get absolute extremum... 0 0 None
698 .radius = 2 * .extremum
699 .blue = 0
700 .green = 0
701 .red = 0
702 if .extremum >= 0.95
703 .red = 1
704 elsif .extremum >= 0.49
705 .green = 1
706 else
707 .green = .extremum / 0.5
708 endif
709 .color$ = "{'.red','.green','.blue'}"
710 demo Colour... '.color$'
711 demo Line width... 1
712 demo Draw circle... 5 95 '.radius'
713 # Reset
714 demoShow()
715 demo Colour... Black
716 demo Line width... 'defaultLineWidth'
717 # Process sound
718 Rename... Tmp
719 Resample... 10000 50
720 Rename... Pronunciation
721 recordedSound$ = selected$("Sound")
722 select Sound Tmp
723 Remove
724 select Sound 'recordedSound$'
726 # Cut out real sound from silences/noise
727 call sound_detection 'recordedSound$' 'soundMargin'
728 select Sound 'recordedSound$'
729 endproc
732 # Select real sound from recording
733 # Uses some global variable
734 procedure sound_detection .sound$ .margin
735 select Sound '.sound$'
736 .soundlength = Get total duration
737 .internalSilence = 2*.margin
739 # Silence and remove noise, DANGEROUS
740 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
741 Rename... Input'.sound$'
743 select TextGrid Input'.sound$'
744 .numberofIntervals = Get number of intervals... 1
746 # Remove buzzing and other obnoxious sounds (if switched on)
747 for .i from 1 to .numberofIntervals
748 select TextGrid Input'.sound$'
749 .value$ = Get label of interval... 1 '.i'
750 .begintime = Get starting point... 1 '.i'
751 .endtime = Get end point... 1 '.i'
753 # Remove noise
754 if .value$ = "silent"
755 select Sound '.sound$'
756 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
757 endif
758 endfor
760 # Select target sound
761 .maximumIntensity = -1
762 .counter = 1
763 for i from 1 to .numberofIntervals
764 select TextGrid Input'.sound$'
766 .value$ = Get label of interval... 1 'i'
767 .begintime = Get starting point... 1 'i'
768 .endtime = Get end point... 1 'i'
770 if .value$ != "silent"
771 if .begintime > .margin
772 .begintime -= .margin
773 else
774 .begintime = 0
775 endif
776 if .endtime + .margin < .soundlength
777 .endtime += .margin
778 else
779 .endtime = .soundlength
780 endif
782 select Sound '.sound$'
783 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
784 Rename... Tmp'.sound$'
785 Subtract mean
786 .newIntensity = Get intensity (dB)
787 if .newIntensity > .maximumIntensity
788 if .maximumIntensity > 0
789 select Sound New'.sound$'
790 Remove
791 endif
792 select Sound Tmp'.sound$'
793 Rename... New'.sound$'
794 .maximumIntensity = .newIntensity
795 else
796 select Sound Tmp'.sound$'
797 Remove
798 endif
799 #
800 endif
801 endfor
802 if .maximumIntensity > minimumIntensity
803 select Sound '.sound$'
804 Remove
805 select Sound New'.sound$'
806 Rename... '.sound$'
807 elsif .maximumIntensity > -1
808 select Sound New'.sound$'
809 Remove
810 endif
811 select TextGrid Input'.sound$'
812 Remove
813 endproc
815 procedure end_program
816 call write_preferences ""
817 demo Erase all
818 select all
819 Remove
820 exit
821 endproc
823 ######################################################
824 #
825 # Configuration Page
826 #
827 ######################################################
828 procedure config_page
829 demo Erase all
830 demoWindowTitle("Speak Good Chinese: Change settings")
831 .label$ = ""
832 call Draw_config_page
834 while (.label$ <> "Return") and demoWaitForInput()
835 .clickX = -1
836 .clickY = -1
837 .pressed$ = ""
838 .label$ = ""
839 if demoClicked()
840 .clickX = demoX()
841 .clickY = demoY()
842 call buttonClicked 'config$' '.clickX' '.clickY'
843 .label$ = buttonClicked.label$
844 elsif demoKeyPressed()
845 .pressed$ = demoKey$()
846 call keyPressed 'config$' '.pressed$'
847 .label$ = keyPressed.label$
848 endif
850 # You cannot select a text field
851 if startsWith(.label$, "$")
852 .label$ = ""
853 endif
855 # Do things
856 if .label$ != ""
857 # Handle push button in process_config
858 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
859 endif
861 if .label$ = "Return"
862 goto GOBACK
863 endif
864 endwhile
866 # Go back
867 label GOBACK
868 call init_window
869 endproc
871 procedure Draw_config_page
872 demo Erase all
873 # Draw background
874 if config.showBackground
875 call draw_background Background
876 endif
877 # Draw buttons
878 call Draw_all_buttons 'config$'
879 call set_window_title 'config$'
880 # Set correct buttons (alert)
881 call setConfigMainPage
882 endproc
884 # Do what is asked
885 procedure process_config .label$ .clickX .clickY .pressed$
886 if .label$ = "!Logging"
887 config.logPerformance = not config.logPerformance
888 .displayButton = config.logPerformance
889 call Draw_button 'config$' +'.label$' '.displayButton'
890 if config.logPerformance
891 call start_logging
892 endif
893 elsif .label$ <> "" and not startsWith(.label$,"!")
894 .label$ = replace$(.label$, "_", " ", 0)
895 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
896 endif
897 endproc
899 ###############################################################
900 #
901 # Presenting help texts
902 #
903 ###############################################################
905 # Process Help
906 procedure help_loop .table$ .redrawProc$
907 # General Help text
908 call write_help_title '.table$'
910 .label$ = ""
911 call Draw_button '.table$' Help 2
912 .redrawScreen = 0
913 while (.label$ <> "Help") and demoWaitForInput()
914 .label$ = ""
915 if demoClicked()
916 .clickX = demoX()
917 .clickY = demoY()
918 call buttonClicked '.table$' '.clickX' '.clickY'
919 .label$ = buttonClicked.label$
920 elsif demoKeyPressed()
921 .pressed$ = demoKey$()
922 call keyPressed '.table$' '.pressed$'
923 .label$ = keyPressed.label$
924 endif
926 if .label$ != "" and .label$ <> "Help"
927 # Redraw screen
928 if .redrawScreen
929 demo Erase all
930 call '.redrawProc$'
931 else
932 .redrawScreen = 1
933 endif
934 call Draw_button '.table$' Help 2
935 call write_help_title '.table$'
937 # Handle push button in process_config
938 call write_help_text '.table$' '.label$'
939 endif
941 endwhile
943 # Reset button
944 call Draw_button '.table$' Help 0
945 demo Erase all
946 call '.redrawProc$'
947 endproc
949 # Write help text
950 procedure write_help_text .table$ .label$
951 call findLabel '.table$' '.label$'
952 .row = findLabel.row
953 select Table '.table$'
954 # Get text
955 if .row <= 0
956 call findLabel '.table$' Help
957 .row = findLabel.row
958 select Table '.table$'
959 endif
960 .helpText$ = Get value... '.row' Helptext
961 .helpKey$ = Get value... '.row' Key
962 .helpKey$ = replace$(.helpKey$, "\", "", 0)
963 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
964 if index_regex(.helpKey$, "\S")
965 .helpText$ = .helpText$+" ("+.helpKey$+")"
966 endif
967 # Get button values
968 .leftX = Get value... '.row' LeftX
969 .rightX = Get value... '.row' RightX
970 .lowY = Get value... '.row' LowY
971 .highY = Get value... '.row' HighY
973 # PopUp dimensions
974 .currentHelpFontSize = defaultFontSize
975 call set_font_size '.currentHelpFontSize'
976 .helpTextSize = demo Text width (wc)... '.helpText$'
977 .helpTextSize += 4
978 if .leftX > 50
979 .htXleft = 20
980 .htXright = .htXleft + .helpTextSize + 5
981 .xstart = .leftX
982 else
983 .htXright = 80
984 .htXleft = .htXright - .helpTextSize - 5
985 .xstart = .rightX
986 endif
987 if .lowY > 50
988 .htYlow = 40
989 .htYhigh = .htYlow + 7
990 .ystart = .lowY
991 .yend = .htYhigh
992 else
993 .htYhigh = 60
994 .htYlow = .htYhigh - 7
995 .ystart = .highY
996 .yend = .htYlow
997 endif
999 # Adapt font size to horizontal dimensions
1000 .maxWidth = 90
1001 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1002 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1003 if .htXleft < 0 or .htXright > 100
1004 .htXleft = 0
1005 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1006 endif
1007 call set_font_size '.currentHelpFontSize'
1009 # Adapt vertical dimensions to font height
1010 call points_to_wc '.currentHelpFontSize'
1011 .lineHeight = points_to_wc.wc
1012 if .lineHeight > .htYhigh - .htYlow - 4
1013 .htYhigh = .htYlow + .lineHeight + 4
1014 endif
1016 # Determine arrow endpoints
1017 .xend = .htXleft
1018 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1019 .xend = .htXright
1020 endif
1021 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1022 .xend = (.htXleft+.htXright)/2
1023 endif
1025 .xtext = .htXleft + 2
1026 .ytext = .htYlow + 1
1028 # Draw pop-up
1029 .mm2wc = demo Horizontal mm to wc... 1
1030 .lineWidth = 2/.mm2wc
1031 demo Line width... '.lineWidth'
1032 demo Arrow size... '.lineWidth'
1033 demo Colour... {0.5,0.5,1}
1034 demo Paint rectangle... {0.9,0.9,1} '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1035 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1036 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1037 demo Line width... 'defaultLineWidth'
1038 demo Arrow size... 1
1039 demo Black
1040 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1041 demoShow()
1042 call set_font_size 'defaultFontSize'
1044 endproc
1046 procedure write_help_title .table$
1047 # Set help text title
1048 # General Help text
1049 call findLabel '.table$' Help
1050 .row = findLabel.row
1051 select Table '.table$'
1052 .helpTitle$ = Get value... '.row' Helptext
1053 .helpKey$ = Get value... '.row' Key
1054 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1055 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1056 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1058 call reset_viewport
1059 .helpTitleFontSize = 14
1060 # Adapt size of button to length of text
1061 .maxWidth = 80
1062 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1063 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1064 call set_font_size '.helpTitleFontSize'
1065 .helpTop = 100
1067 demo Select inner viewport... 0 100 0 100
1068 demo Axes... 0 100 0 100
1069 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1070 call set_font_size 'defaultFontSize'
1071 call reset_viewport
1072 endproc
1074 ###############################################################
1075 #
1076 # Miscelaneous procedures
1077 #
1078 ###############################################################
1079 procedure printPageToPrinter
1080 call print_window
1081 demo Print... 'printerName$' 'printerPresets$'
1082 call init_window
1083 endproc
1085 procedure getOpenFile .openDialogue$
1086 call convert_praat_to_utf8 '.openDialogue$'
1087 .openDialogue$ = convert_praat_to_utf8.text$
1088 .filename$ = chooseReadFile$ (.openDialogue$)
1089 if .filename$ <> "" and fileReadable(.filename$)
1090 Read from file... '.filename$'
1091 call log_fileOpen '.filename$'
1093 # Get only the filename
1094 .startName = rindex_regex(.filename$, "[/\\:]") + 1
1095 .nameLength = rindex(.filename$, ".") - .startName
1096 currentSoundName$ = mid$(.filename$, .startName, .nameLength)
1097 else
1098 Create Sound from formula... Speech Mono 0 1 44100 0
1099 endif
1100 recordedSound$ = selected$("Sound")
1101 currentStartTime = 0
1102 currentEndTime = Get total duration
1103 # Reset selected window
1104 selectedStartTime = currentStartTime
1105 selectedEndTime = currentEndTime
1106 endproc
1108 procedure points_to_wc .points
1109 .mm = .points * 0.3527777778
1110 .wc = demo Vertical mm to wc... '.mm'
1111 endproc
1113 procedure reset_viewport
1114 .low = viewportMargin
1115 .high = 100 - viewportMargin
1116 demo Select inner viewport... '.low' '.high' '.low' '.high'
1117 demo Axes... 0 100 0 100
1118 endproc
1120 procedure set_font_size .fontSize
1121 call reset_viewport
1122 demo Font size... '.fontSize'
1123 call reset_viewport
1124 endproc
1126 procedure wipeArea .areaCommand$
1127 call reset_viewport
1128 '.areaCommand$'
1129 endproc
1131 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1132 demo '.font$'
1133 call set_font_size '.currentFontSize'
1134 .textWidth = demo Text width (wc)... '.text$'
1135 while .textWidth > .maxWidth and .currentFontSize > 2
1136 .currentFontSize -= 0.5
1137 call set_font_size '.currentFontSize'
1138 .textWidth = demo Text width (wc)... '.text$'
1139 endwhile
1140 .diff = .textWidth - .maxWidth
1141 .newFontSize = .currentFontSize
1142 demo 'defaultFont$'
1143 endproc
1145 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1146 demo '.font$'
1147 .radians = .rotation/360 * 2 * pi
1148 .horWC = demo Horizontal mm to wc... 10.0
1149 .verWC = demo Vertical mm to wc... 10.0
1150 if .horWC > 0
1151 .verCoeff = .verWC / .horWC
1152 else
1153 .verCoeff = 1
1154 endif
1155 call set_font_size '.currentFontSize'
1156 .textLength = demo Text width (wc)... '.text$'
1157 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1158 .currentFontSize -= 0.5
1159 call set_font_size '.currentFontSize'
1160 .textLength = demo Text width (wc)... '.text$'
1161 endwhile
1162 .diff = .textLength - .maxHeight
1163 .newFontSize = .currentFontSize
1164 demo 'defaultFont$'
1165 endproc
1167 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1168 demo '.font$'
1169 call points_to_wc '.currentFontSize'
1170 .lineHeight = points_to_wc.wc
1171 while .lineHeight > .maxHeight and .currentFontSize > 2
1172 .currentFontSize -= 0.5
1173 call points_to_wc '.currentFontSize'
1174 .lineHeight = points_to_wc.wc
1175 endwhile
1176 .diff = .lineHeight - .maxHeight
1177 .newFontSize = .currentFontSize
1178 demo 'defaultFont$'
1179 endproc
1181 # Load a table with button info etc.
1182 # Load local tables if present. Else load
1183 # build-in scripted tables
1184 procedure loadTable .tableName$
1185 # Search for the table in local, preference, and global directories
1186 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1187 Read from file... 'localTableDir$'/'.tableName$'.Table
1188 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1189 Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1190 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1191 Read from file... 'globaltablelists$'/'.tableName$'.Table
1192 # Load them from script
1193 else
1194 call Create'.tableName$'
1195 endif
1196 endproc
1198 # Create a pop-up window with text from a Text Table
1199 procedure write_text_table .table$
1200 .xleft = 10
1201 .xright = 90
1202 .ylow = 20
1203 .yhigh = 85
1204 .lineHeight = 2.5
1206 # Get table with text and longest line
1207 call loadTable '.table$'
1208 .instructionText = selected()
1209 .numLines = Get number of rows
1210 .instructionFontSize = 14
1211 .referenceText$ = ""
1212 .maxlenght = 0
1213 .maxLine = 0
1214 .maxFontSize = 0
1215 .maxWidth = 0
1216 for .l to .numLines
1217 select '.instructionText'
1218 .currentText$ = Get value... '.l' text
1219 # Expand variables, eg, 'praatVersion$'
1220 call expand_praat_variables '.currentText$'
1221 .currentText$ = expand_praat_variables.text$
1223 .font$ = Get value... '.l' font
1224 .fontSize = Get value... '.l' size
1225 call set_font_size '.fontSize'
1226 .textWidth = demo Text width (wc)... '.currentText$'
1227 if .fontSize > .maxFontSize
1228 .maxFontSize = .fontSize
1229 endif
1230 if .textWidth > .maxWidth
1231 .maxWidth = .textWidth
1232 .instructionFontSize = .fontSize
1233 .maxLine = .l
1234 endif
1235 endfor
1236 select '.instructionText'
1237 .referenceText$ = Get value... '.maxLine' text
1238 .maxLineFont$ = Get value... '.maxLine' font
1239 .instructionFontSize = Get value... '.maxLine' size
1240 call set_font_size '.maxFontSize'
1242 # Adapt size of button to length of text
1243 .maxWidth = (.xright - .xleft) - 4
1244 .origFontSize = .instructionFontSize
1245 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1246 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1247 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1248 if adjustFontSizeOnWidth.diff > 0
1249 .xright += adjustFontSizeOnWidth.diff/4
1250 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1251 endif
1252 call set_font_size '.instructionFontSize'
1253 .fontSizeFactor = .instructionFontSize / .origFontSize
1255 .numRows = Get number of rows
1256 # Calculate length from number of lines.
1257 .dy = .lineHeight
1258 .midY = .yhigh - (.yhigh - .ylow)/2
1259 .yhigh = .midY + (.numRows+1) * .dy / 2
1260 .ylow = .yhigh - (.numRows+1) * .dy
1261 .textleft = .xleft + 2
1263 demo Line width... 8
1264 demo Colour... {0.5,0.5,1}
1265 demo Paint rectangle... {0.9,0.9,1} '.xleft' '.xright' '.ylow' '.yhigh'
1266 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1267 demo Line width... 'defaultLineWidth'
1268 demo Black
1269 .ytext = .yhigh - 2 - .dy
1270 for .i to .numRows
1271 select '.instructionText'
1272 .font$ = Get value... '.i' font
1273 .fontSize = Get value... '.i' size
1274 .font$ = extractWord$(.font$, "")
1275 # Scale font
1276 .fontSize = floor(.fontSize*.fontSizeFactor)
1277 if .fontSize < 4
1278 .fontSize = 4
1279 endif
1280 .line$ = Get value... '.i' text
1281 # Expand variables, eg, 'praatVersion$'
1282 call expand_praat_variables '.line$'
1283 .line$ = expand_praat_variables.text$
1285 # Display text
1286 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1287 .ytext -= .dy
1288 endfor
1289 demoShow()
1290 call set_font_size 'defaultFontSize'
1292 select '.instructionText'
1293 Remove
1294 endproc
1296 # Create a pop-up window with a given text
1297 procedure write_text_popup .font$ .size .text$
1298 .xleft = 10
1299 .xright = 90
1300 .ylow = 20
1301 .yhigh = 85
1302 .lineHeight = 3
1304 # Adapt size of button to length of text
1305 .maxWidth = (.xright - .xleft) - 4
1306 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1307 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1308 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1309 if adjustFontSizeOnWidth.diff > 0
1310 .xright += adjustFontSizeOnWidth.diff/4
1311 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1312 else
1313 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1314 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1315 endif
1317 .numRows = 1
1318 # Calculate length from number of lines.
1319 .dy = .lineHeight
1320 .midY = .yhigh - (.yhigh - .ylow)/2
1321 .yhigh = .midY + (.numRows+1) * .dy / 2
1322 .ylow = .yhigh - (.numRows+1) * .dy
1323 .textleft = .xleft + 2
1324 .xmid = (.textleft + .xright - 2)/2
1326 demo Line width... 8
1327 demo Colour... {0.5,0.5,1}
1328 demo Paint rectangle... {0.9,0.9,1} '.xleft' '.xright' '.ylow' '.yhigh'
1329 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1330 demo Line width... 'defaultLineWidth'
1331 demo Black
1332 .ytext = .yhigh - 2 - .dy
1333 # Write text
1334 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1336 demoShow()
1337 demo 'defaultFont$'
1338 call set_font_size 'defaultFontSize'
1339 endproc
1341 # Write the background from a Text Table
1342 procedure draw_background .table$
1343 .xleft = 0
1344 .xright = 100
1345 .ylow = 0
1346 .yhigh = 100
1347 .lineHeight = 5
1348 .defaultColour$ = "{0.9,0.9,0.9}"
1349 .defaultAlign$ = "centre"
1351 # Get table with text and longest line
1352 call loadTable '.table$'
1353 .backgroundText = selected()
1354 .numLines = Get number of rows
1355 .backgroundFontSize = 28
1356 .referenceText$ = ""
1357 .maxlenght = 0
1358 .maxLine = 0
1359 .maxFontSize = 0
1360 .maxWidth = 0
1361 .textLines = 0
1362 for .l to .numLines
1363 select '.backgroundText'
1364 .currentText$ = Get value... '.l' text
1365 # Expand variables, eg, 'praatVersion$'
1366 call expand_praat_variables '.currentText$'
1367 .currentText$ = expand_praat_variables.text$
1369 .font$ = Get value... '.l' font
1370 .fontSize = Get value... '.l' size
1371 if .fontSize > .maxFontSize
1372 .maxFontSize = .fontSize
1373 endif
1374 if not startsWith(.font$, "!")
1375 call set_font_size '.fontSize'
1376 .textWidth = demo Text width (wc)... '.currentText$'
1377 if .textWidth > .maxWidth
1378 .maxWidth = .textWidth
1379 .backgroundFontSize = .fontSize
1380 .maxLine = .l
1381 endif
1383 .textLines += 1
1384 endif
1385 endfor
1386 if .maxLine > 0
1387 select '.backgroundText'
1388 .referenceText$ = Get value... '.maxLine' text
1389 .maxLineFont$ = Get value... '.maxLine' font
1390 .backgroundFontSize = Get value... '.maxLine' size
1391 .backgroundFontColour$ = Get value... '.maxLine' colour
1392 call set_font_size '.maxFontSize'
1393 else
1394 .maxFontSize = .backgroundFontSize
1395 endif
1397 # Adapt size of button to length of text
1398 .maxWidth = (.xright - .xleft) - 4
1399 .origFontSize = .backgroundFontSize
1400 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1401 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1402 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1403 call set_font_size '.backgroundFontSize'
1405 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1406 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1407 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1408 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1409 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1410 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1411 endif
1413 .numRows = Get number of rows
1414 # Calculate length from number of lines.
1415 .dy = .lineHeight
1416 .midY = .yhigh - (.yhigh - .ylow)/2
1417 .yhigh = .midY + (.textLines+1) * .dy / 2
1418 .ylow = .yhigh - (.textLines+1) * .dy
1419 .textleft = .xleft + 2
1420 .textright = .xright - 2
1421 .textmid = (.xright - .xleft)/2
1423 demo Black
1424 .ytext = .yhigh - 2 - .dy
1425 for .i to .numRows
1426 select '.backgroundText'
1427 .font$ = Get value... '.i' font
1428 .fontSize = Get value... '.i' size
1429 .fontColour$ = Get value... '.i' colour
1430 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1431 .fontAlign$ = Get value... '.i' align
1432 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1433 .line$ = Get value... '.i' text
1434 # Expand variables, eg, 'praatVersion$'
1435 call expand_praat_variables '.line$'
1436 .line$ = expand_praat_variables.text$
1438 # Scale font
1439 .fontSize = floor(.fontSize*.fontSizeFactor)
1440 if not startsWith(.font$, "!")
1441 .font$ = extractWord$(.font$, "")
1443 if .fontAlign$ = "centre"
1444 .xtext = .textmid
1445 elsif .fontAlign$ = "right"
1446 .xtext = .textright
1447 else
1448 .xtext = .textleft
1449 endif
1450 if .fontSize < 4
1451 .fontSize = 4
1452 endif
1453 # Clean up text
1454 demo Colour... '.fontColour$'
1455 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1456 .ytext -= .dy
1457 elsif .font$ = "!demo command"
1458 demo Colour... '.fontColour$'
1459 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1460 demo '.line$'
1461 endif
1462 endfor
1463 demo Black
1464 demoShow()
1465 call set_font_size 'defaultFontSize'
1467 select '.backgroundText'
1468 Remove
1469 endproc
1471 procedure convert_praat_to_utf8 .text$
1472 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1473 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1474 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1475 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1476 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1477 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1478 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1479 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1480 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1481 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1482 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1483 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1484 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1485 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1486 endproc
1488 # Expand 'variable$' into the value of variable$.
1489 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1490 # Single quotes can be protected by \'
1491 procedure expand_praat_variables .text$
1492 if index(.text$, "'")
1493 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1494 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1495 .tempText$ = """"+.tempText$+""""
1496 # Check whether all the variables actually exist. Ignore any variable that does not exist
1497 .checkVars$ = .tempText$
1498 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1499 .start = index(.checkVars$, "+")
1500 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1501 .end = index(.checkVars$, "+")
1502 if .end
1503 .variable$ = left$(.checkVars$, .end - 1)
1504 if not variableExists(.variable$)
1505 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1506 endif
1507 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1508 else
1509 .checkVars$ = ""
1510 endif
1511 endwhile
1512 .text$ = '.tempText$'
1513 endif
1514 endproc