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