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