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