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