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
  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
  29 # Define variable that will be reset in Initialise*.praat
  30 # These are simply "useful" defaults
  31 localTableDir$ = "Data"
  32 buttonsTableName$ = "Buttons"
  33 configTableName$ = "Config"
  34 buttons$ = ""
  35 config$ = ""
  36 recordedSound$ = ""
  37 # Parameters for isolating recorded speech from noise
  38 # Should be mostly left alone unless you are using ultra clean
  39 # or very noisy recordings
  40 noiseThresshold = -30
  41 minimumPitch = 60
  42 soundMargin = 0.25
  43 minimumIntensity = 30
  44
  45 # Define canvas
  46 viewportMargin = 5
  47 defaultFontSize = 12
  48 defaultFont$ = "Helvetica"
  49 defaultLineWidth = 1
  50
  51 # Set up system
  52 call reset_viewport
  53
  54 # Load supporting scripts
  55 # Set up system and load preferences
  56 include InitialiseSGC2.praat
  57 # Include the main page buttons and procedures
  58 include Buttons.praat
  59 # Include the configuration page buttons and procedures
  60 include Config.praat
  61 # Load tables in script format
  62 include CreateTables.praat
  63 include CreateWordlists.praat
  64
  65 # Start instruction loop
  66 while demoWaitForInput()
  67         .label$ = ""
  68         .clickX = -1
  69         .clickY = -1
  70         .pressed$ = ""
  71         if demoClicked()
  72                 .clickX = demoX()
  73                 .clickY = demoY()
  74                 call buttonClicked 'buttons$' '.clickX' '.clickY'
  75                 .label$ = buttonClicked.label$
  76         elsif demoKeyPressed()
  77                 .pressed$ = demoKey$()
  78                 call keyPressed 'buttons$' '.pressed$'
  79                 .label$ = keyPressed.label$
  80         endif
  81
  82         # Do things
  83         if .label$ != ""
  84                 # Push button down
  85                 call Draw_button 'buttons$' '.label$' 1
  86                 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
  87                 # push button up
  88                 call Draw_button 'buttons$' '.label$' 0
  89         endif
  90 endwhile
  91
  92 call end_program
  93
  94
  95 ########################################################
  96 #
  97 # Definitions of procedures
  98 #
  99 ########################################################
 100 #
 101 # Do what is asked
 102 procedure process_label .label$ .clickX .clickY .pressed$
 103         if .label$ <> "" and not startsWith(.label$,"!")
 104                 .label$ = replace$(.label$, "_", " ", 0)
 105                 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
 106         endif
 107 endproc
 108
 109 # Intialize buttons
 110 procedure init_buttons
 111         call Draw_all_buttons 'buttons$'
 112 endproc
 113
 114 # Draw all buttons
 115 procedure Draw_all_buttons .table$
 116         select Table '.table$'
 117         .numRows = Get number of rows
 118
 119         for .row to .numRows
 120                 .label$ = Get value... '.row' Label
 121         if not startsWith(.label$, "!")
 122                     call Draw_button '.table$' '.label$' 0
 123         endif
 124         endfor
 125 endproc
 126
 127 # Draw a button from a predefined button table
 128 procedure Draw_button .table$ .label$ .push
 129         # Scale rounding of rounded rectangles
 130         .wc = 1
 131         .mm = demo Horizontal wc to mm... '.wc'
 132     # Allow to overide ! skip directive
 133     .forceDraw = 0
 134     if startsWith(.label$, "+")
 135         .label$ = right$(.label$, length(.label$)-1)
 136         .forceDraw = 1
 137     endif
 138
 139     select Table '.table$'
 140     .row = Search column... Label '.label$'
 141         if .row < 1
 142                 exit Button Table '.table$' does not have a row with label '.label$'
 143         endif
 144
 145         # Perspective shift sizes
 146         .shiftDown = 0.05
 147     .shiftX = 0.30
 148     .shiftY = 0.50
 149         # Set drawing parameters
 150         .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
 151         .topLineColorUp$ = "Black"
 152         .topLineWidthUp = 1.5
 153         .topBackGroundColorDown$ = "{0.89,0.89,0.89}"
 154         .topLineColorDown$ = "Grey"
 155         .topLineWidthDown = 1.5
 156         .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
 157         .flankLineColorUp$ = "{0.2,0.2,0.2}"
 158         .flankLineWidthUp = 1.5
 159         .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
 160         .flankLineColorDown$ = .flankLineColorUp$
 161         .flankLineWidthDown = 1.5
 162         .buttonFontSize = defaultFontSize
 163
 164         # Get button values
 165     .leftX = Get value... '.row' LeftX
 166     .rightX = Get value... '.row' RightX
 167     .lowY = Get value... '.row' LowY
 168     .highY = Get value... '.row' HighY
 169     .buttonText$ = Get value... '.row' Text
 170     .buttonColor$ = Get value... '.row' Color
 171     .buttonDraw$ = Get value... '.row' Draw
 172     .buttonKey$ = Get value... '.row' Key
 173
 174     goto NOBUTTON startsWith(.label$, "!") and not .forceDraw
 175
 176     # Replace button text with ALERT
 177     if .push = 3
 178         .buttonText$ = alertText$
 179     endif
 180
 181         # Adapt size of button to length of text
 182         .maxWidth = (.rightX - .leftX) - 2
 183         call adjustFontSizeOnWidth '.buttonFontSize' '.maxWidth' '.buttonText$'
 184         .buttonFontSize = adjustFontSizeOnWidth.newFontSize
 185         if adjustFontSizeOnWidth.diff > 0
 186                 .rightX += adjustFontSizeOnWidth.diff/2
 187                 .leftX -= adjustFontSizeOnWidth.diff/2
 188         endif
 189         call set_font_size '.buttonFontSize'
 190
 191         # Adapt size of button to length of text
 192         .maxHeight = (.highY - .lowY) - 1
 193         call adjustFontSizeOnHeight '.buttonFontSize' '.maxHeight'
 194         if adjustFontSizeOnHeight.diff > 0
 195                 .lowY -= adjustFontSizeOnHeight.diff/2
 196                 .highY += adjustFontSizeOnHeight.diff/2
 197         endif
 198         .buttonFontSize = adjustFontSizeOnHeight.newFontSize
 199
 200         # Reset and erase button area
 201         call reset_viewport
 202     demo Line width... 'defaultLineWidth'
 203     .shiftLeftX = .leftX - .shiftX
 204     .shiftRightX = .rightX
 205     .shiftLowY = .lowY - .shiftY
 206     .shiftHighY = .highY
 207         demo Paint rectangle... White .shiftLeftX .shiftRightX .shiftLowY .shiftHighY
 208
 209     # Give some depth to button: Draw flank outline
 210         if .push <= 0
 211         demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
 212                 demo Colour... '.flankLineColorUp$'
 213         demo Line width... '.flankLineWidthUp'
 214         else
 215         demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
 216                 demo Colour... '.flankLineColorDown$'
 217         demo Line width... '.flankLineWidthDown'
 218         endif
 219     demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
 220
 221         # Button Down will shift the top perspective
 222
 223     # Draw the button top
 224         if .push <= 0
 225         demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
 226                 demo Colour... '.topLineColorUp$'
 227         demo Line width... '.topLineWidthUp'
 228         else
 229                 # Button Down
 230                 .leftX -= .shiftDown
 231                 .rightX -= .shiftDown
 232                 .lowY -= .shiftDown
 233                 .highY -= .shiftDown
 234
 235         demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
 236                 demo Colour... '.topLineColorDown$'
 237         demo Line width... '.topLineWidthDown'
 238         endif
 239     demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
 240
 241     # The button text and symbol
 242     .centerX = (.leftX + .rightX)/2
 243     .centerY = .lowY + 0.6*(.highY-.lowY)
 244     .radius = (.highY - .lowY )/4
 245         .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
 246         if .newText$ = ""
 247                 .newText$ = .buttonText$
 248         endif
 249         if .push = 1
 250                 demo Grey
 251                 if .buttonColor$ = "Red"
 252                         .buttonColor$ = "Pink"
 253                 elsif .buttonColor$ = "Blue"
 254                         .buttonColor$ = "{0.5,0.5,1}"
 255                 else
 256                         .buttonColor$ = "Grey"
 257                 endif
 258     elsif .push >= 2
 259         .buttonColor$ = "Maroon"
 260         else
 261         demo Colour... Black
 262         endif
 263
 264     call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
 265         call set_font_size '.buttonFontSize'
 266     demo Colour... '.buttonColor$'
 267     demo Text... '.centerX' Centre '.lowY' Bottom '.newText$'
 268         demoShow()
 269
 270         # Reset
 271         call set_font_size 'defaultFontSize'
 272     demo Black
 273     demo Line width... 'defaultLineWidth'
 274
 275     label NOBUTTON
 276 endproc
 277
 278 procedure set_window_title .table$ .addedText$
 279     select Table '.table$'
 280     .row = Search column... Label !WindowTitle
 281         if .row < 1
 282                 exit Button Table '.table$' does not have a row with label !WindowTitle
 283         endif
 284         .windowText$ = Get value... '.row' Text
 285
 286     demoWindowTitle(.windowText$+ .addedText$)
 287 endproc
 288
 289 # Handle language setting
 290 procedure processLanguageCodes .table$ .label$
 291         .table$ = "Config"
 292      call Draw_button 'config$' Lang_'language$' 0
 293     call Draw_button 'config$' '.label$' 2
 294     # Someone might have to use more than 2 chars for the language code
 295     .numChars = length(.label$) - length("Lang_")
 296         .lang$ = right$(.label$, .numChars)
 297     # Load new tables
 298     call set_language '.lang$'
 299 endproc
 300
 301 # Set the language
 302 procedure set_language .lang$
 303         .redraw_config = 0
 304     # Remove old tables
 305     if buttons$ <> ""
 306         select Table 'buttons$'
 307         Remove
 308                 .redraw_config = 1
 309     endif
 310     if config$ <> ""
 311         select Table 'config$'
 312         Remove
 313                 .redraw_config = 1
 314     endif
 315
 316     # Set language
 317     language$ = .lang$
 318
 319     # Load buttons tables
 320     call loadTable 'buttonsTableName$'
 321     buttons$ = selected$("Table")
 322     Append column... Text
 323     Append column... Key
 324     Append column... Helptext
 325     .numLabels = Get number of rows
 326     call loadTable 'buttonsTableName$'_'language$'
 327     .buttonsLang$ = selected$("Table")
 328     for .row to .numLabels
 329                 select Table 'buttons$'
 330                 .label$ = Get value... '.row' Label
 331         call findLabel '.buttonsLang$' '.label$'
 332             if findLabel.row > 0
 333             select Table '.buttonsLang$'
 334                 .valueText$ = Get value... 'findLabel.row' Text
 335                 .valueKey$ = Get value... 'findLabel.row' Key
 336                 .valueHelp$ = Get value... 'findLabel.row' Helptext
 337                 select Table 'buttons$'
 338                 Set string value... '.row' Text '.valueText$'
 339                 Set string value... '.row' Key '.valueKey$'
 340                 Set string value... '.row' Helptext '.valueHelp$'
 341                 elsif index(.label$, "_")
 342                         # Load alternative language table
 343                         .startChar = rindex(.label$, "_")
 344                         .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
 345                         call loadTable 'buttonsTableName$'_'.otherLanguage$'
 346                 .otherbuttonsLang$ = selected$("Table")
 347                 call findLabel '.otherbuttonsLang$' '.label$'
 348                 if findLabel.row > 0
 349                 select Table '.buttonsLang$'
 350                         .valueText$ = Get value... 'findLabel.row' Text
 351                         .valueKey$ = Get value... 'findLabel.row' Key
 352                         .valueHelp$ = Get value... 'findLabel.row' Helptext
 353                         select Table 'buttons$'
 354                         Set string value... '.row' Text '.valueText$'
 355                         Set string value... '.row' Key '.valueKey$'
 356                         Set string value... '.row' Helptext '.valueHelp$'
 357                 else
 358                 exit Cannot find Label: '.otherbuttonsLang$' '.label$'
 359                 endif
 360                         select Table '.otherbuttonsLang$'
 361                         Remove
 362         else
 363             exit Cannot find Label: '.buttonsLang$' '.label$'
 364         endif
 365     endfor
 366     select Table '.buttonsLang$'
 367     Remove
 368
 369     # Load configuration table
 370     call loadTable 'configTableName$'
 371     config$ = selected$("Table")
 372     Append column... Text
 373     Append column... Key
 374     Append column... Helptext
 375     .numLabels = Get number of rows
 376     call loadTable 'configTableName$'_'language$'
 377     .configLang$ = selected$("Table")
 378     for .row to .numLabels
 379                 select Table 'config$'
 380                 .label$ = Get value... '.row' Label
 381         call findLabel '.configLang$' '.label$'
 382             if findLabel.row > 0
 383             select Table '.configLang$'
 384                 .valueText$ = Get value... 'findLabel.row' Text
 385                 .valueKey$ = Get value... 'findLabel.row' Key
 386                 .valueHelp$ = Get value... 'findLabel.row' Helptext
 387                 select Table 'config$'
 388                 Set string value... '.row' Text '.valueText$'
 389                 Set string value... '.row' Key '.valueKey$'
 390                 Set string value... '.row' Helptext '.valueHelp$'
 391                 elsif index(.label$, "_")
 392                         .startChar = rindex(.label$, "_")
 393                         .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
 394                         call loadTable 'configTableName$'_'.otherLanguage$'
 395                 .otherconfigLang$ = selected$("Table")
 396                 call findLabel '.otherconfigLang$' '.label$'
 397                 if findLabel.row > 0
 398                 select Table '.otherconfigLang$'
 399                         .valueText$ = Get value... 'findLabel.row' Text
 400                         .valueKey$ = Get value... 'findLabel.row' Key
 401                         .valueHelp$ = Get value... 'findLabel.row' Helptext
 402                         select Table 'config$'
 403                         Set string value... '.row' Text '.valueText$'
 404                         Set string value... '.row' Key '.valueKey$'
 405                         Set string value... '.row' Helptext '.valueHelp$'
 406                 else
 407                 exit Cannot find Label: '.otherconfigLang$' '.label$'
 408                 endif
 409                         select Table '.otherconfigLang$'
 410                         Remove
 411         else
 412             exit Cannot find Label: '.configLang$' '.label$'
 413         endif
 414     endfor
 415     select Table '.configLang$'
 416     Remove
 417
 418         # Make language change visible
 419         if .redraw_config
 420                 call Draw_config_page
 421         endif
 422
 423 endproc
 424
 425 ###############################################################
 426 #
 427 # Button Drawing Routines
 428 #
 429 ###############################################################
 430
 431 # A stub for buttons that do not have a drawing routine (yet)
 432 procedure DrawNull .color$ .x .y .size
 433 endproc
 434
 435 procedure DrawHelp .color$ .x .y .size
 436         .currentFontSize = 24
 437         .y -= .size
 438         .maxHeight = 2*.size
 439         call adjustFontSizeOnHeight '.currentFontSize' '.maxHeight'
 440         .currentFontSize = adjustFontSizeOnHeight.currentFontSize
 441         call set_font_size '.currentFontSize'
 442         demo Colour... '.color$'
 443         demo Text... '.x' Centre '.y' Bottom ?
 444         call set_font_size 'defaultFontSize'
 445 endproc
 446
 447 ###############################################################
 448 #
 449 # Button Processing Routines
 450 #
 451 ###############################################################
 452
 453 # Search row in table on label
 454 procedure findKey .table$ .label$
 455         .row = 0
 456         select Table '.table$'
 457         .to$ = selected$("Table")
 458         .to$ = "Table_"+.to$
 459         .numRows = Get number of rows
 460         for .i to .numRows
 461                 .currentKey$ = '.to$'$[.i, "Key"]
 462                 if .label$ = .currentKey$
 463                         .row = .i
 464                         goto KEYFOUND
 465                 endif
 466         endfor
 467         label KEYFOUND
 468         if .row <= 0 and index(.label$, "_") <= 0
 469                 printline "'.label$'" is not a key in '.table$'
 470         endif
 471 endproc
 472
 473 procedure findLabel .table$ .label$
 474         .row = 0
 475         select Table '.table$'
 476         .to$ = selected$("Table")
 477         .to$ = "Table_"+.to$
 478         .numRows = Get number of rows
 479         for .i to .numRows
 480                 .currentKey$ = '.to$'$[.i, "Label"]
 481                 if .label$ = .currentKey$
 482                         .row = .i
 483                         goto LABELFOUND
 484                 endif
 485         endfor
 486         label LABELFOUND
 487         if .row <= 0 and index(.label$, "_") <= 0
 488                 exit "'.label$'" is not a key in '.table$'
 489         endif
 490 endproc
 491
 492 # Get the label
 493 procedure buttonClicked table$ .x .y
 494         .label$ = ""
 495         select Table 'table$'
 496         .bo$ = selected$("Table")
 497         .bo$ = "Table_"+.bo$
 498         .numRows = Get number of rows
 499         for .i to .numRows
 500                 if .label$ = ""
 501                         .leftX = '.bo$'[.i, "LeftX"]
 502                         .rightX = '.bo$'[.i, "RightX"]
 503                         .lowY = '.bo$'[.i, "LowY"]
 504                         .highY = '.bo$'[.i, "HighY"]
 505                         if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
 506                                 .label$ = '.bo$'$[.i, "Label"]
 507                         endif
 508                 endif
 509         endfor
 510 endproc
 511
 512 procedure keyPressed table$ .pressed$
 513         .label$ = ""
 514         # Magic
 515         if .pressed$ = ""
 516                 .label$ = "Refresh"
 517         endif
 518         .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
 519         .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
 520         select Table 'table$'
 521         .bo$ = selected$("Table")
 522         .bo$ = "Table_"+.bo$
 523         .numRows = Get number of rows
 524         for .i to .numRows
 525                 if .label$ = ""
 526                         .key$ = '.bo$'$[.i, "Key"]
 527                         if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
 528                                 .label$ = '.bo$'$[.i, "Label"]
 529                         endif
 530                 endif
 531         endfor
 532 endproc
 533
 534
 535 procedure play_sound .sound$
 536     if .sound$ <> ""
 537         select Sound '.sound$'
 538         Play
 539     endif
 540 endproc
 541
 542 procedure record_sound
 543     if recordedSound$ != ""
 544         select Sound 'recordedSound$'
 545         Remove
 546         recordedSound$ = ""
 547     endif
 548         # Recording light
 549     demo Paint circle... Red 5 95 2
 550     demoShow()
 551     nowarn Record Sound (fixed time)... 'soundInput$' 0.99 1 44100 4
 552     demo Paint circle... White 5 95 2.5
 553     call wipeArea 'wipeFeedbackArea$'
 554         # Feedback on recording level
 555         .extremum = Get absolute extremum... 0 0 None
 556         .radius = 2 * .extremum
 557         .blue = 0
 558         .green = 0
 559         .red = 0
 560         if .extremum >= 0.95
 561                 .red = 1
 562         elsif .extremum >= 0.49
 563                 .green = 1
 564         else
 565                 .green = .extremum / 0.5
 566         endif
 567         .color$ = "{'.red','.green','.blue'}"
 568         demo Colour... '.color$'
 569         demo Line width... 1
 570         demo Draw circle... 5 95 '.radius'
 571         # Reset
 572     demoShow()
 573         demo Colour... Black
 574         demo Line width... 'defaultLineWidth'
 575         # Process sound
 576     Rename... Tmp
 577     Resample... 10000 50
 578     Rename... Pronunciation
 579     recordedSound$ = selected$("Sound")
 580     select Sound Tmp
 581     Remove
 582     select Sound 'recordedSound$'
 583
 584         # Cut out real sound from silences/noise
 585         call sound_detection 'recordedSound$' 'soundMargin'
 586         select Sound 'recordedSound$'
 587 endproc
 588
 589
 590 # Select real sound from recording
 591 # Uses some global variable
 592 procedure sound_detection .sound$ .margin
 593         select Sound '.sound$'
 594         .soundlength = Get total duration
 595         .internalSilence = 2*.margin
 596
 597         # Silence and remove noise, DANGEROUS
 598         To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
 599         Rename... Input'.sound$'
 600
 601         select TextGrid Input'.sound$'
 602         .numberofIntervals = Get number of intervals... 1
 603
 604         # Remove buzzing and other obnoxious sounds (if switched on)
 605         for .i from 1 to .numberofIntervals
 606            select TextGrid Input'.sound$'
 607            .value$ = Get label of interval... 1 '.i'
 608            .begintime = Get starting point... 1 '.i'
 609            .endtime = Get end point... 1 '.i'
 610
 611                 # Remove noise
 612                 if .value$ = "silent"
 613                         select Sound '.sound$'
 614                         Set part to zero... '.begintime' '.endtime' at nearest zero crossing
 615                 endif
 616         endfor
 617
 618         # Select target sound
 619         .maximumIntensity = -1
 620         .counter = 1
 621         for i from 1 to .numberofIntervals
 622            select TextGrid Input'.sound$'
 623
 624            .value$ = Get label of interval... 1 'i'
 625            .begintime = Get starting point... 1 'i'
 626            .endtime = Get end point... 1 'i'
 627
 628            if .value$ != "silent"
 629            if .begintime > .margin
 630                   .begintime -= .margin
 631            else
 632                    .begintime = 0
 633            endif
 634            if .endtime + .margin < .soundlength
 635                    .endtime += .margin
 636            else
 637                    .endtime = .soundlength
 638            endif
 639
 640            select Sound '.sound$'
 641            Extract part... '.begintime' '.endtime' Rectangular 1.0 no
 642            Rename... Tmp'.sound$'
 643            Subtract mean
 644            .newIntensity = Get intensity (dB)
 645            if .newIntensity > .maximumIntensity
 646                    if .maximumIntensity > 0
 647                    select Sound New'.sound$'
 648                    Remove
 649                    endif
 650                    select Sound Tmp'.sound$'
 651                    Rename... New'.sound$'
 652                    .maximumIntensity = .newIntensity
 653            else
 654                    select Sound Tmp'.sound$'
 655                    Remove
 656            endif
 657            #
 658            endif
 659         endfor
 660         if .maximumIntensity > minimumIntensity
 661                 select Sound '.sound$'
 662                 Remove
 663                 select Sound New'.sound$'
 664                 Rename... '.sound$'
 665         elsif .maximumIntensity > -1
 666                 select Sound New'.sound$'
 667                 Remove
 668         endif
 669         select TextGrid Input'.sound$'
 670         Remove
 671 endproc
 672
 673 procedure end_program
 674         call write_preferences ""
 675         demo Erase all
 676         select all
 677         Remove
 678         exit
 679 endproc
 680
 681 ######################################################
 682 #
 683 # Configuration Page
 684 #
 685 ######################################################
 686 procedure config_page
 687     demo Erase all
 688     demoWindowTitle("Speak Good Chinese: Change settings")
 689     .label$ = ""
 690     call Draw_config_page
 691
 692         .clickX = -1
 693         .clickY = -1
 694     .pressed$ = ""
 695     while (.label$ <> "Return") and demoWaitForInput()
 696             .label$ = ""
 697             if demoClicked()
 698                     .clickX = demoX()
 699                     .clickY = demoY()
 700                     call buttonClicked 'config$' '.clickX' '.clickY'
 701                     .label$ = buttonClicked.label$
 702             elsif demoKeyPressed()
 703                     .pressed$ = demoKey$()
 704                     call keyPressed 'config$' '.pressed$'
 705                     .label$ = keyPressed.label$
 706             endif
 707
 708             # Do things
 709             if .label$ != ""
 710                     # Handle push button in process_config
 711                     call process_config '.label$' '.clickX' '.clickY' '.pressed$'
 712             endif
 713
 714         if .label$ = "Return"
 715             goto GOBACK
 716         endif
 717     endwhile
 718
 719     # Go back
 720     label GOBACK
 721     call init_window
 722 endproc
 723
 724 procedure Draw_config_page
 725         demo Erase all
 726     call Draw_all_buttons 'config$'
 727         call set_window_title 'config$'
 728     # Set correct buttons (alert)
 729         call setConfigButtons
 730 endproc
 731
 732 # Do what is asked
 733 procedure process_config .label$ .clickX .clickY .pressed$
 734         if .label$ = "!Logging"
 735                 logPerformance = not logPerformance
 736                 .displayButton = logPerformance
 737         call Draw_button 'config$' +'.label$' '.displayButton'
 738         if logPerformance
 739                 call start_logging
 740         endif
 741         elsif .label$ <> "" and not startsWith(.label$,"!")
 742                 .label$ = replace$(.label$, "_", " ", 0)
 743                 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
 744         endif
 745 endproc
 746
 747 ###############################################################
 748 #
 749 # Presenting help texts
 750 #
 751 ###############################################################
 752
 753 # Process Help
 754 procedure help_loop .table$ .redrawProc$
 755         # General Help text
 756         call  write_help_title '.table$'
 757
 758     .label$ = ""
 759     call Draw_button '.table$' Help 2
 760
 761     while (.label$ <> "Help") and demoWaitForInput()
 762             .label$ = ""
 763             if demoClicked()
 764                     .clickX = demoX()
 765                     .clickY = demoY()
 766                     call buttonClicked '.table$' '.clickX' '.clickY'
 767                     .label$ = buttonClicked.label$
 768             elsif demoKeyPressed()
 769                     .pressed$ = demoKey$()
 770                     call keyPressed '.table$' '.pressed$'
 771                     .label$ = keyPressed.label$
 772             endif
 773
 774             if .label$ != "" and .label$ <> "Help"
 775                     # Handle push button in process_config
 776                     call write_help_text '.table$' '.label$' '.redrawProc$'
 777             endif
 778
 779     endwhile
 780
 781         # Reset button
 782     call Draw_button '.table$' Help 0
 783         demo Erase all
 784         call '.redrawProc$'
 785 endproc
 786
 787 # Write help text
 788 procedure write_help_text .table$ .label$ .redrawProc$
 789         call findLabel '.table$' '.label$'
 790         .row = findLabel.row
 791         select Table '.table$'
 792         # Get text
 793         if .row <= 0
 794                 call findLabel '.table$' Help
 795                 .row = findLabel.row
 796                 select Table '.table$'
 797         endif
 798         .helpText$ = Get value... '.row' Helptext
 799         .helpKey$ = Get value... '.row' Key
 800         .helpKey$ = replace$(.helpKey$, "\", "", 0)
 801         .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
 802         .helpText$ = .helpText$+" ("+.helpKey$+")"
 803         # Get button values
 804     .leftX = Get value... '.row' LeftX
 805     .rightX = Get value... '.row' RightX
 806     .lowY = Get value... '.row' LowY
 807     .highY = Get value... '.row' HighY
 808
 809         # PopUp dimensions
 810         .currentHelpFontSize = defaultFontSize
 811     call set_font_size '.currentHelpFontSize'
 812         .helpTextSize = demo Text width (wc)... '.helpText$'
 813         .helpTextSize += 4
 814         if .leftX > 50
 815                 .htXleft = 20
 816                 .htXright = .htXleft + .helpTextSize + 5
 817                 .xstart = .leftX
 818         else
 819                 .htXright = 80
 820                 .htXleft = .htXright - .helpTextSize - 5
 821                 .xstart = .rightX
 822         endif
 823         if .lowY > 50
 824                 .htYlow = 40
 825                 .htYhigh = .htYlow + 7
 826                 .ystart = .lowY
 827                 .yend = .htYhigh
 828         else
 829                 .htYhigh = 60
 830                 .htYlow = .htYhigh - 7
 831                 .ystart = .highY
 832                 .yend = .htYlow
 833         endif
 834
 835         # Adapt font size to horizontal dimensions
 836         .maxWidth = 90
 837         call adjustFontSizeOnWidth '.currentHelpFontSize' '.maxWidth' '.helpText$'
 838         .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
 839         if .htXleft < 0 or .htXright > 100
 840                 .htXleft = 0
 841                 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
 842         endif
 843         call set_font_size '.currentHelpFontSize'
 844
 845         # Adapt vertical dimensions to font height
 846         call points_to_wc '.currentHelpFontSize'
 847         .lineHeight = points_to_wc.wc
 848         if .lineHeight > .htYhigh - .htYlow - 4
 849                 .htYhigh = .htYlow + .lineHeight + 4
 850         endif
 851
 852         # Determine arrow endpoints
 853         .xend = .htXleft
 854         if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
 855                 .xend = .htXright
 856         endif
 857         if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
 858                 .xend = (.htXleft+.htXright)/2
 859         endif
 860
 861         .xtext = .htXleft + 2
 862         .ytext = .htYlow + 1
 863
 864         # Draw pop-up
 865         .mm2wc = demo Horizontal mm to wc... 1
 866         .lineWidth = 2/.mm2wc
 867         demo Line width... '.lineWidth'
 868         demo Arrow size... '.lineWidth'
 869         demo Colour... {0.5,0.5,1}
 870         demo Paint rectangle... {0.9,0.9,1} '.htXleft' '.htXright' '.htYlow' '.htYhigh'
 871         demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
 872         demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
 873         demo Line width... 'defaultLineWidth'
 874         demo Arrow size... 1
 875         demo Black
 876         demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
 877         demoShow()
 878         call set_font_size 'defaultFontSize'
 879
 880         # Now wait for some input to continue
 881         demoWaitForInput()
 882
 883         # Redraw screen
 884         demo Erase all
 885         call '.redrawProc$'
 886         call Draw_button '.table$' Help 2
 887         call  write_help_title '.table$'
 888 endproc
 889
 890 procedure write_help_title .table$
 891         # Set help text title
 892         # General Help text
 893         call findLabel '.table$' Help
 894         .row = findLabel.row
 895         select Table '.table$'
 896         .helpTitle$ = Get value... '.row' Helptext
 897         .helpKey$ = Get value... '.row' Key
 898         .helpKey$ = replace$(.helpKey$, "\", "", 0)
 899         .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
 900         .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
 901
 902         call reset_viewport
 903         .helpTitleFontSize = 14
 904         # Adapt size of button to length of text
 905         .maxWidth = 80
 906         call adjustFontSizeOnWidth '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
 907         .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
 908         call set_font_size '.helpTitleFontSize'
 909         .helpTop = 100
 910
 911         demo Select inner viewport... 0 100 0 100
 912         demo Axes... 0 100 0 100
 913         demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
 914     call set_font_size 'defaultFontSize'
 915         call reset_viewport
 916 endproc
 917
 918 ###############################################################
 919 #
 920 # Miscelaneous procedures
 921 #
 922 ###############################################################
 923 procedure points_to_wc .points
 924         .mm = .points * 0.3527777778
 925         .wc = demo Vertical mm to wc... '.mm'
 926 endproc
 927
 928 procedure reset_viewport
 929         .low = viewportMargin
 930         .high = 100 - viewportMargin
 931         demo Select inner viewport... '.low' '.high' '.low' '.high'
 932         demo Axes... 0 100 0 100
 933 endproc
 934
 935 procedure set_font_size .fontSize
 936         call reset_viewport
 937         demo Font size... '.fontSize'
 938         call reset_viewport
 939 endproc
 940
 941 procedure wipeArea .areaCommand$
 942         call reset_viewport
 943         '.areaCommand$'
 944 endproc
 945
 946 procedure adjustFontSizeOnWidth .currentFontSize .maxWidth .text$
 947         demo 'defaultFont$'
 948         call set_font_size '.currentFontSize'
 949         .textWidth = demo Text width (wc)... '.text$'
 950         while .textWidth > .maxWidth and .currentFontSize > 4
 951                 .currentFontSize -= 0.5
 952                 call set_font_size '.currentFontSize'
 953                 .textWidth = demo Text width (wc)... '.text$'
 954         endwhile
 955         .diff = .textWidth - .maxWidth
 956         .newFontSize = .currentFontSize
 957 endproc
 958
 959 procedure adjustFontSizeOnHeight .currentFontSize .maxHeight
 960         call points_to_wc '.currentFontSize'
 961         .lineHeight = points_to_wc.wc
 962         while .lineHeight > .maxHeight and .currentFontSize > 4
 963                 .currentFontSize -= 0.5
 964                 call points_to_wc '.currentFontSize'
 965                 .lineHeight = points_to_wc.wc
 966         endwhile
 967         .diff = .lineHeight - .maxHeight
 968         .newFontSize = .currentFontSize
 969 endproc
 970
 971 # Load a table with button info etc.
 972 # Load local tables if present. Else load
 973 # build-in scripted tables
 974 procedure loadTable .tableName$
 975         # Search for the table in local, preference, and global directories
 976         if fileReadable("'localTableDir$'/'.tableName$'.Table")
 977         Read from file... 'localTableDir$'/'.tableName$'.Table
 978         elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
 979         Read from file... 'preferencesTableDir$'/'.tableName$'.Table
 980         elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
 981         Read from file... 'globaltablelists$'/'.tableName$'.Table
 982         # Load them from script
 983         else
 984                 call Create'.tableName$'
 985         endif
 986 endproc
 987
 988 # Create a pop-up window with text from a Text Table
 989 procedure write_text_table .table$
 990         .xleft = 10
 991         .xright = 90
 992         .ylow = 20
 993         .yhigh = 85
 994         .lineHeight = 2.5
 995
 996         # Get table with text and longest line
 997         call loadTable '.table$'
 998         .instructionText = selected()
 999         .numLines = Get number of rows
1000         .instructionFontSize = 14
1001         .referenceText$ = ""
1002         .maxlenght = 0
1003         .maxLine = 0
1004         .maxFontSize = 0
1005         .maxWidth = 0
1006         for .l to .numLines
1007                 select '.instructionText'
1008                 .currentText$ = Get value... '.l' text
1009                 .font$ = Get value... '.l' font
1010                 .fontSize = Get value... '.l' size
1011                 call set_font_size '.fontSize'
1012                 .textWidth = demo Text width (wc)... '.currentText$'
1013                 if .fontSize > .maxFontSize
1014                         .maxFontSize = .fontSize
1015                 endif
1016                 if .textWidth > .maxWidth
1017                         .maxWidth = .textWidth
1018                         .instructionFontSize = .fontSize
1019                         .maxLine = .l
1020                 endif
1021         endfor
1022         select '.instructionText'
1023         .referenceText$ = Get value... '.maxLine' text
1024         .maxLineFont$ = Get value... '.maxLine' font
1025         .instructionFontSize = Get value... '.maxLine' size
1026         call set_font_size '.maxFontSize'
1027
1028         # Adapt size of button to length of text
1029         .maxWidth = (.xright - .xleft) - 4
1030         .origFontSize = .instructionFontSize
1031         call adjustFontSizeOnWidth '.instructionFontSize' '.maxWidth' '.referenceText$'
1032         call adjustFontSizeOnHeight '.maxFontSize' '.lineHeight'
1033         .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1034         if adjustFontSizeOnWidth.diff > 0
1035                 .xright += adjustFontSizeOnWidth.diff/4
1036                 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1037         endif
1038         call set_font_size '.instructionFontSize'
1039         .fontSizeFactor = .instructionFontSize / .origFontSize
1040
1041         .numRows = Get number of rows
1042         # Calculate length from number of lines.
1043         .dy = .lineHeight
1044         .midY = .yhigh - (.yhigh - .ylow)/2
1045         .yhigh = .midY + (.numRows+1) * .dy / 2
1046         .ylow = .yhigh - (.numRows+1) * .dy
1047         .textleft = .xleft + 2
1048
1049         demo Line width... 8
1050         demo Colour... {0.5,0.5,1}
1051         demo Paint rectangle... {0.9,0.9,1} '.xleft' '.xright' '.ylow' '.yhigh'
1052         demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1053         demo Line width... 'defaultLineWidth'
1054         demo Black
1055         .ytext = .yhigh - 2 - .dy
1056         for .i to .numRows
1057                 select '.instructionText'
1058                 .font$ = Get value... '.i' font
1059                 .fontSize = Get value... '.i' size
1060                 .font$ = extractWord$(.font$, "")
1061                 # Scale font
1062                 .fontSize = floor(.fontSize*.fontSizeFactor)
1063                 if .fontSize < 6
1064                         .fontSize = 6
1065                 endif
1066                 .line$ = Get value... '.i' text
1067                 # Clean up text
1068                 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1069                 .ytext -= .dy
1070         endfor
1071         demoShow()
1072         call set_font_size 'defaultFontSize'
1073
1074         select '.instructionText'
1075         Remove
1076 endproc
1077
1078