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