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