sgc2.praat

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