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