Update patch to Praat 5.3.80 (mingw not complete)
[sgc2.git] / MainPage.praat
blob11745969032c366b64f725ca3e9f0ba1b076a40d
2 # SpeakGoodChinese 2.0
3
4 # Praat script handling buttons page
6 #     SpeakGoodChinese: MainPage.praat loads the code needed for the 
7 #     main, practice, page of SGC2 and the sound handling and recognition.
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 # Includes at the bottom
30 ###############################################################
32 # Button Drawing Routines
34 ###############################################################
36 procedure DrawPrevious .color$ .x .y .size
37         demo '.color$'
38         .size *= 2/3
39         call drawTriangle -1 .x .y .size
40         .currentX = drawTriangle.currentX
41         .endX = .currentX - 0.5
42         .lowY = .y - .size
43         .highY = .y + .size
44         demo Paint rectangle... '.color$' '.currentX' '.endX' '.lowY' '.highY'
45 endproc
47 procedure DrawNext .color$ .x .y .size
48         demo '.color$'
49         .size *= 2/3
50         call drawTriangle 1 .x .y .size
51         .currentX = drawTriangle.currentX
52         .endX = .currentX + 0.5
53         .lowY = .y - .size
54         .highY = .y + .size
55         demo Paint rectangle... '.color$' '.currentX' '.endX' '.lowY' '.highY'
56 endproc
58 procedure DrawWordListUp .color$ .x .y .size
59     .xleft = .x - .size
60     .xright = .x + .size
61     .xmidleft = .x + 0.1
62     .xmidright = .x - 0.1
63     .ylow = .y
64     .yhigh = .y + .size
65         demo '.color$'
66         demo Line width... 3
67         demo Draw line... .xleft .ylow .xmidleft .yhigh
68         demo Draw line... .xright .ylow .xmidright .yhigh
69         demo Line width... 'defaultLineWidth'
70         demo Black
71 endproc
73 procedure DrawWordListDown .color$ .x .y .size
74     .xleft = .x - .size
75     .xright = .x + .size
76     .xmidleft = .x + 0.1
77     .xmidright = .x - 0.1
78     .yhigh = .y + .size
79     .ylow = .y
80         demo '.color$'
81         demo Line width... 3
82         demo Draw line... .xleft .yhigh .xmidleft .ylow
83         demo Draw line... .xright .yhigh .xmidright .ylow
84         demo Line width... 'defaultLineWidth'
85         demo Black
86 endproc
88 procedure drawTriangle .direction .x .y .size
89         # Make sure direction = +/- 1
90         if .direction = 0
91                 .direction = 1 
92         endif
93         .direction /= abs(.direction)
94         
95         .offset = 0.01
96         .currentHeight = .size
97         .currentX = .x - .direction*.size
98         
99         demo Line width... 2.0
101         while .currentHeight> 0
102                 .ystart = .y + .currentHeight
103                 .yend = .y - .currentHeight
104                 demo Draw line... .currentX .ystart .currentX .yend
105                 .currentHeight -= .offset *3/4
106                 .currentX += .direction*.offset * 1.5
107         endwhile
108         demo Line width... 'defaultLineWidth'
109 endproc
111 ###############################################################
113 # Obligatory button Drawing Routines
115 # These MUST be defined
117 ###############################################################
119 procedure DrawRecord .color$ .x .y .size
120         .size /= 2
121     demo Paint circle... '.color$' '.x' '.y' '.size'
122 endproc
124 procedure DrawPlay .color$ .x .y .size
125         demo '.color$'
126         call drawTriangle 1 .x .y .size
127 endproc
129 procedure DrawQuit .color$ .x .y .size
130         demo Colour... '.color$'
131         .lineWidth = 0.5*.size**2
132         demo Line width... '.lineWidth'
133         .xstart = .x - .size
134         .ystart = .y + .size
135         .xend = .x + .size
136         .yend = .y - .size
137         demo Draw line... .xstart .ystart .xend .yend
138         .xstart = .x - .size
139         .ystart = .y - .size
140         .xend = .x + .size
141         .yend = .y + .size
142         demo Draw line... .xstart .ystart .xend .yend
143         demo Line width... 'defaultLineWidth'
144         demo Colour... Black
145 endproc
147 procedure DrawConfig .color$ .x .y .size
148         .size *= 1
149         .lineWidth = 0.4*.size
150         demo Arrow size... '.lineWidth'
151         .lineWidth = 0.4*.size**2
152         demo Line width... '.lineWidth'
153         .y += .size/2
154         .xstart = .x - .size
155         .xend = .x + .size
156         demo Draw arrow... .xstart .y .xend .y
157         demo Line width... 'defaultLineWidth'
158 endproc
160 procedure DrawRefresh .color$ .x .y .size
161         .lineWidth = 0.5*.size**2
162         .size /= 2
163         demo Line width... '.lineWidth'
164         demo Draw arc... '.x' '.y' '.size' 0 270
165         demo Line width... 'defaultLineWidth'
166 endproc
168 ###############################################################
170 # Button Processing Routines
172 ###############################################################
174 procedure processMainPageExample .clickX .clickY .pressed$
175         call generate_example
176 endproc
178 procedure processMainPagePrevious .clickX .clickY .pressed$
179         call clean_up_sound
180         call display_text Grey
181         te.currentWord -= 1
182         call init_window
183         # Draw the contour
184         call wipeArea 'wipeFeedbackArea$'
185         call display_text Black
186 endproc
188 procedure processMainPageNext .clickX .clickY .pressed$
189         call clean_up_sound
190         call display_text Grey
191         te.currentWord += 1
192         call init_window
193         # Draw the contour
194         call wipeArea 'wipeFeedbackArea$'
195         call display_text Black
196 endproc
198 procedure processMainPageWordlistUp .clickX .clickY .pressed$
199         call wipeArea 'wipeFeedbackArea$'
200     call load_word_list "'localWordlistDir$'" -1
201         call init_window
202         call display_text Black
203 endproc
205 procedure processMainPageWordlistDown .clickX .clickY .pressed$
206         call wipeArea 'wipeFeedbackArea$'
207     call load_word_list "'localWordlistDir$'" 1
208         call init_window
209         call display_text Black
210 endproc
212 ###############################################################
214 # Obligatory button Processing Routines
216 # These MUST be defined
218 ###############################################################
220 procedure processMainPageQuit .clickX .clickY .pressed$
221         call end_program
222 endproc
224 procedure processMainPageRefresh .clickX .clickY .pressed$
225         call init_window
226 endproc
228 procedure processMainPageConfig .clickX .clickY .pressed$
229         call config_page
230 endproc
232 procedure processMainPageHelp .clickX .clickY .pressed$
233         call help_loop 'buttons$' init_window
234 endproc
236 procedure processMainPagePlay .clickX .clickY .pressed$
237         call play_sound 'recordedSound$'
238 endproc
240 procedure processMainPageRecord .clickX .clickY .pressed$
241     call record_sound
242     call recognizeTone
244     # Wipe screen
245     call wipeArea 'wipeContourArea$'
246    
247     call draw_tone_contour
248     # Write text (again)
249     call display_word_list_name
250     call display_text Black
251         call add_feedback_to_toneevaluation Feedback
252     call write_feedback Feedback
253         select Table Feedback
254         Remove
255 endproc
258 ###############################################################
260 # Miscelaneous supporting code
262 ###############################################################
264 # The example
265 procedure generate_example
266         select Table 'wordlist$'
267         if te.currentWord > 0 and te.currentWord <= te.numberOfWords
268                 select Table 'wordlist$'
269                 .sound$ = Get value... 'te.currentWord' Sound
270                 .pinyin$ = Get value... 'te.currentWord' Pinyin
271                 if .sound$ = "-" or .sound$ = ""
272                         .sound$ = .pinyin$+".wav"
273                 endif
274                 .soundFilePath$ = localWordlistDir$+"/"+wordlistName$+"/"+.sound$
275                 .wordlistDirectory$ = ""
276                 if localWordlistDir$ <> "" and fileReadable("'localWordlistDir$'/'wordlistName$'")
277                         .wordlistDirectory$ = "'localWordlistDir$'/'wordlistName$'"
278                 elsif sgc2wordlists$ <> "" and fileReadable("'sgc2wordlists$'/'wordlistName$'")
279                         .wordlistDirectory$ = "'sgc2wordlists$'/'wordlistName$'"
280                 elsif globalwordlists$ <> "" and fileReadable("'globalwordlists$'/'wordlistName$'")
281                         .wordlistDirectory$ = "'globalwordlists$'/'wordlistName$'"
282                 endif
283                 if .wordlistDirectory$ <> ""
284                         .audioExampleList = Create Strings as file list... AudioList '.wordlistDirectory$'/'.pinyin$'.*
285                         .number_of_examples = Get number of strings
286                         if .number_of_examples > 0
287                                 Randomize
288                                 .sound$ = Get string... 1
289                                 .soundFilePath$ = "'.wordlistDirectory$'/'.sound$'"
290                         endif
291                         Remove
292                 endif
293                 if fileReadable(.soundFilePath$) and config.useSoundExample
294                         Read from file... '.soundFilePath$'
295                         Play
296                         Remove
297                 elsif config.synthesis$ <> "" and config.synthesis$ <> "_DISABLED_"
298                         call synthesize_sound '.pinyin$'
299                 else
300                         call humToneContour '.pinyin$' 'config.register'
301                         call reset_viewport
302                 endif
303         endif
304         demoShow()
305 endproc
307 # Draw a tone contour
308 procedure draw_tone_contour
309         select Table 'wordlist$'
310         if te.currentWord > 0 and te.currentWord <= te.numberOfWords
311                 .sound$ = Get value... 'te.currentWord' Sound
312                 .pinyin$ = Get value... 'te.currentWord' Pinyin
313                 call drawToneContour '.pinyin$' 'config.register'
314                 call reset_viewport
315                 
316                 if te.recordedPitch > 0
317                         call drawSourceToneContour te.recordedPitch
318                 endif
319         endif
321 endproc
323 procedure recognizeTone
324         select Table 'wordlist$'
325         if te.currentWord > 0 and te.currentWord <= te.numberOfWords
326                 .sound$ = Get value... 'te.currentWord' Sound
327                 .pinyin$ = Get value... 'te.currentWord' Pinyin
328                 call align_recordedSound '.pinyin$'
329         call sgc_ToneProt 'recordedSound$' '.pinyin$' 'config.register' 'config.strict' 'config.language$'
330         # sgc_ToneProt manipulates the sound given. Reconnect
331         select Sound 'recordedSound$'
332         te.recordedSound = selected("Sound")
333                 call reset_viewport
334         endif
335 endproc
337 procedure write_feedback .table$
338     select Table '.table$'
339     .line1$ = Get value... 1 Text
340     .line2$ = Get value... 2 Text
341     .label$ = Get value... 3 Text
343         # convert numbers to Pinyin if needed
344         if not config.displayNumbers
345                 call numbers2pinyin '.line1$'
346                 .line1$ = numbers2pinyin.pinyin$
347         endif
349     .color$ = "Red"
350     if index(.line1$, "???") > 0
351         .color$ = "Black"
352     elsif .label$ = "Correct"
353         .color$ = "Green"
354         elsif config.strict
355                 .line2$ = .line2$ + " *"
356     endif
358         .currentFeedbackFontSize = 14
359         .maxHeight = 21 - 17
360         call adjustFontSizeOnHeight 'defaultFont$' '.currentFeedbackFontSize' '.maxHeight'
361         .currentFeedbackFontSize = adjustFontSizeOnHeight.newFontSize
362         
363         call wipeArea 'wipeFeedbackArea$'
364     call set_font_size '.currentFeedbackFontSize'
365     demo '.color$'
366     demo Text... 50 Centre 21 Bottom '.line1$'
367     demo Text... 50 Centre 17 Bottom '.line2$'
368         demoShow()
369         demo 'defaultFont$'
370     call set_font_size 'defaultFontSize'
371     
372         # Log performance
373         .splitIndex = index(.line1$, ": ")
374         .pinyin$ = left$(.line1$, (.splitIndex - 1))
375         .choice$ = right$(.line1$, (length(.line1$) - .splitIndex - 1))
376         call log_performance 'recordedSound$' 'config.register' 'config.strict' '.pinyin$' '.choice$'
377 endproc
379 # Text display
380 procedure display_text .color$
381         select Table 'wordlist$'
382         if te.currentWord < 0 or te.currentWord > te.numberOfWords+1
383                 call clean_up_sound
384         if config.shuffleLists
385                     Randomize rows
386         endif
387                 if te.currentWord < 0
388                         te.currentWord = te.numberOfWords
389                 else
390                         te.currentWord = 1
391                 endif
392         endif
393         
394         if te.currentWord > 0 and te.currentWord <= te.numberOfWords
395                 .displayText$ = ""
396                 .displayPinyin$ = Get value... 'te.currentWord' Pinyin
397                 .displayChar$ = Get value... 'te.currentWord' Character
398                 .displayTrans$ = Get value... 'te.currentWord' Translation
399                 if .displayPinyin$ <> "-" and config.displayPinyin
400                         if not config.displayNumbers
401                                 call numbers2pinyin '.displayPinyin$'
402                                 .displayPinyin$ = numbers2pinyin.pinyin$
403                         endif
404                         # Insert u umlaut
405                         .displayPinyin$ = replace_regex$(.displayPinyin$, "v", "\\u\X22", 0)
406                         .displayText$ = .displayText$ + .displayPinyin$
407                 endif
408                 if .displayChar$ <> "-" and config.displayChar
409                         .displayText$ = .displayText$ + "  "+ .displayChar$
410                 endif
411                 if .displayTrans$ <> "-" and config.displayTrans
412                         .displayText$ = .displayText$ + "  \s{%%"+ .displayTrans$ + "%}"
413                 endif
414         elsif te.currentWord = 0 or te.currentWord = te.numberOfWords+1
415                 call clean_up_sound
416                 .displayText$ = "---"
417         endif
419         # Adapt font size
420         call adjustFontSizeOnHeight 'defaultFont$' 24 15
421         .currentFontSize = adjustFontSizeOnHeight.newFontSize
422         call adjustFontSizeOnWidth 'defaultFont$' '.currentFontSize' 95 '.displayText$'
423         .currentFontSize = adjustFontSizeOnWidth.newFontSize
425         # Clear the writing area
426         call wipeArea 'wipePinyinArea$'
427         # Actually display text
428         demo '.color$'
429         call set_font_size '.currentFontSize'
430         demo Text... 50 Centre 26 Bottom '.displayText$'
431         demoShow()
432         demo Black
433         demo 'defaultFont$'
434         call set_font_size 'defaultFontSize'
435 endproc
437 procedure numbers2pinyin .numberstext$
438         .intermediatePinyin$ = .numberstext$
439         # Move numbers to the nucleus vowel
440         # Tot he vowel
441         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "([aeuiov])([^aeuiov0-9]*)([0-9])", "\1\3\2", 0)
442         # Either a/e
443         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "([ae])([aeuiov]*)([0-9])", "\1\3\2", 0)
444         # Or the Oo in /ou/
445         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "(ou)([0-9])", "o\2u", 0)
446         # or the second vowel
447         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "([uiov][aeuiov])([uiov])([0-9])", "\1\3\2", 0)
448         
449         # Convert all to special characters
450         # Tone 1
451         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "a1", "ā", 0)
452         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "e1", "ē", 0)
453         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "u1", "ū", 0)
454         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "i1", "ī", 0)
455         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "o1", "ō", 0)
456         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v1", "ǖ", 0)
457         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "1", "\\-^", 0)
458         
459         # Tone 2
460         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v2", "ǘ", 0)
461         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "([iaeou])2", "\\\1'", 0)
462         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "2", "\\'^", 0)
463         
464         # Tone 3
465         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "a3", "ǎ", 0)
466         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "e3", "ě", 0)
467         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "u3", "ǔ", 0)
468         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "i3", "ǐ", 0)
469         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "o3", "ǒ", 0)
470         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v3", "ǚ", 0)
471         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "3", "\\N^", 0)
473         # Tone 4
474         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v4", "ǜ", 0)
475         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "([iaeou])4", "\\\1`", 0)
476         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "4", "\\`^", 0)
477         
478         # Tone 0
479         # Remove tone 0 symbol completely
480         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "0", "", 0)
481         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "a0", "å", 0)
482         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "e0", "e̊", 0)
483         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "u0", "ů", 0)
484         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "i0", "i̊", 0)
485         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "o0", "o̊", 0)
486         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v0", "ü̊", 0)
487         #.intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "0", "\\0^", 0)
488         
489         # Pick best vowel symbols available in cases not caught before
490         # Ugly clutch to get the 1, 3, 0 tone diacritics at least in the neighbourhood
491         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "i(\\[-N0]\^)", "i\\s{_ }\1", 0)
492         # Insert u umlaut
493         .intermediatePinyin$ = replace_regex$(.intermediatePinyin$, "v", "\\u\X22", 0)
495         .pinyin$ = .intermediatePinyin$
496 endproc
498 # Includes
499 include ToneProt/SGC_ToneProt.praat
500 include ToneProt/DrawToneContour.praat
501 include ToneProt/HumToneContour.praat
502 include ToneProt/ToneRecognition.praat
503 include ToneProt/ToneScript.praat
504 include ToneProt/ToneRules.praat