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