Small typo corrected in SGC_ToneProt/README.txt
[sgc.git] / SGC_ToneProt / ToneScript.praat
blobcd292317be7be2a26206f4ee186f75fc6857f86b
1 #! praat
3 #     SpeakGoodChinese: ToneScript.praat generates synthetic tone contours
4 #     for Mandarin Chinese
5 #     Copyright (C) 2007  R.J.J.H. van Son
6 #     The SpeakGoodChinese team are:
7 #     Guangqin Chen, Zhonyan Chen, Stefan de Konink, Eveline van Hagen, 
8 #     Rob van Son, Dennis Vierkant, David Weenink
9
10 #     This program is free software; you can redistribute it and/or modify
11 #     it under the terms of the GNU General Public License as published by
12 #     the Free Software Foundation; either version 2 of the License, or
13 #     (at your option) any later version.
14
15 #     This program is distributed in the hope that it will be useful,
16 #     but WITHOUT ANY WARRANTY; without even the implied warranty of
17 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 #     GNU General Public License for more details.
19
20 #     You should have received a copy of the GNU General Public License
21 #     along with this program; if not, write to the Free Software
22 #     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
23
24 form Enter pinyin and tone 1 frequency
25         word inputWord ba1ba1
26         positive upperRegister_(Hz) 300
27     real range_Factor 1
28     real durationScale 1
29     optionmenu generate 1
30         option Pitch
31         option Sound
32         option CorrectPitch
33         option CorrectSound
34 endform
36 # To supress the ToneList, change to 0
37 createToneList = 1
38 if rindex_regex(generate$, "Correct") > 0
39         createToneList = 0
40 endif
42 # Limit lowest tone
43 absoluteMinimum = 80
45 prevTone = -1
46 nextTone = -1
48 point = 0
49 lastFrequency = 0
51 # Clean up input
52 if inputWord$ <> ""
53     inputWord$ = replace_regex$(inputWord$, "^\s*(.+)\s*$", "\1", 1)
54 endif
56 procedure extractTone syllable$
57         toneSyllable = -1
58         currentToneText$ = replace_regex$(syllable$, "^[^\d]+([\d]+)(.*)$", "\1", 0)
59         toneSyllable = extractNumber(currentToneText$, "")
60 endproc
62 procedure convertVoicing voicingSyllable$
63         # Remove tones
64         voicingSyllable$ = replace_regex$(voicingSyllable$, "^([^\d]+)[\d]+", "\1", 0)
65         # Convert voiced consonants
66         voicingSyllable$ = replace_regex$(voicingSyllable$, "(ng|[wrlmny])", "C", 0)
67         # Convert unvoiced consonants
68         voicingSyllable$ = replace_regex$(voicingSyllable$, "(sh|ch|zh|[fsxhktpgqdbzcj])", "U", 0)
69         # Convert vowels
70         voicingSyllable$ = replace_regex$(voicingSyllable$, "([aiuoeĆ¼])", "V", 0)
71 endproc
73 # Add a tone movement. The current time point is 'point'
74 delta = 0.0000001
75 if durationScale <= 0
76     durationScale = 1.0
77 endif
78 segmentDuration = 0.150
79 fixedDuration = 0.12
82 # Movements
83 # start * ?Semit is a fall
84 # start / ?Semit is a rise
85 # 1/(12 semitones)
86 octave = 0.5
87 # 1/(9 semitones)
88 nineSemit = 0.594603557501361
89 # 1/(6 semitones)
90 sixSemit = 0.707106781186547
91 # 1/(3 semitones) down
92 threeSemit = 0.840896415253715
93 # 1/(2 semitones) down
94 twoSemit = 0.890898718140339
95 # 1/(1 semitones) down
96 oneSemit = 0.943874313
97 # 1/(4 semitones) down
98 fourSemit = twoSemit * twoSemit
99 # 1/(5 semitones) down
100 fiveSemit = threeSemit * twoSemit
102 frequency_Range = octave
103 if range_Factor > 0
104     frequency_Range =  frequency_Range * range_Factor
105 endif
107 # Get the rules of the tones
108 include ToneRules.praat
110 # Previous end frequency
111 lastFrequency = 0
112 procedure addToneMovement syllable$ topLine prevTone nextTone
113         # Get tone
114         toneSyllable = -1
115         call extractTone 'syllable$'
116     if toneSyllable = 3 and nextTone = 3
117         toneSyllable = 2
118     endif
120         # Get voicing pattern
121         voicingSyllable$ = ""
122         call convertVoicing 'syllable$'
124         # Account for tones in duration
125         toneFactor = 1
126     # Scale the duration of the current syllable
127     call toneDuration
128         toneFactor = toneFactor * durationScale
130         # Unvoiced part
131         if rindex_regex(voicingSyllable$, "U") = 1
132                 point = point + delta
133         Add point... 'point' 0
134                 point = point + segmentDuration * toneFactor
135         Add point... 'point' 0
136         endif
137         # Voiced part
138         voiceLength$ = replace_regex$(voicingSyllable$, "U*([CV]+)U*", "\1", 0)
139         voicedLength = length(voiceLength$)
140         voicedDuration = toneFactor * (segmentDuration*voicedLength + fixedDuration)
141         point = point + delta
143     # Write contour of each tone
144     # Note that tones are influenced by the previous (tone 0) and next (tone 3)
145     # tones. Tone 6 is the Dutch intonation
146     # sqrt(frequency_Range) is the mid point
147     if topLine * frequency_Range < absoluteMinimum
148         frequency_Range = absoluteMinimum / topLine
149     endif
151     call toneRules
152         
153     lastFrequency = endPoint
155 endproc
157 # Split input into syllables
158 margin = 0.25
160 procedure wordToTones wordInput$ highPitch
161         currentRest$ = wordInput$;
162         syllableCount = 0
163         length = 2 * margin
165     # Split syllables
166         while rindex_regex(currentRest$, "^[^\d]+[\d]+") > 0
167         syllableCount += 1
168         syllable'syllableCount'$ = replace_regex$(currentRest$, "^([^\d]+[\d]+)(.*)$", "\1", 1)
169                 currentSyllable$ = syllable'syllableCount'$
171                 # Get the tone
172                 call extractTone 'currentSyllable$'
173                 toneSyllable'syllableCount' = toneSyllable
174                 currentTone = toneSyllable'syllableCount'
176                 # Get the Voicing pattern
177                 call convertVoicing 'currentSyllable$'
178                 voicingSyllable'syllableCount'$ = voicingSyllable$
179                 currentVoicing$ = voicingSyllable'syllableCount'$
181                 # Calculate new length
182             # Account for tones in duration
183             toneFactor = 1
184         # Scale the duration of the current syllable
185         call toneDuration
186             toneFactor = toneFactor * durationScale
188                 length = length + toneFactor * (length(voicingSyllable'syllableCount'$) * (segmentDuration + delta) + fixedDuration)
190                 # Next round
191                 currentRest$ = replace_regex$(currentRest$, "^([^\d]+[\d]+)(.*)$", "\2", 1)
193                 # Safety valve
194                 if syllableCount > 2000
195                         exit
196                 endif
197         endwhile
199         # Create tone pattern
200         Create PitchTier... 'wordInput$' 0 'length'
202         # Add start margin
203         lastFrequency = 0
204     point = 0
205         Add point... 'point' 0
206         point = margin
207         Add point... 'point' 0
209     lastTone = -1
210     followTone = -1
211         for i from 1 to syllableCount
212                 currentSyllable$ = syllable'i'$
213         currentTone = toneSyllable'i'
214         followTone = -1
215         if i < syllableCount
216             j = i+1
217             followTone = toneSyllable'j'
218         endif
220                 call addToneMovement 'currentSyllable$' 'highPitch' 'lastTone' 'followTone'
222         lastTone = currentTone
223         endfor
225         # Add end margin
226         point = point + delta
227         Add point... 'point' 0
228         point = point + margin
229         Add point... 'point' 0
230 endproc
232 procedure generateWord whatToGenerate$ theWord$ upperRegister
233         call wordToTones 'theWord$' 'upperRegister'
234         # Generate pitch
235     select PitchTier 'theWord$'
236     noprogress To Pitch... 0.0125 60.0 600.0
237         Rename... theOrigWord
238         Smooth... 10
239         Rename... 'theWord$'
240         select Pitch theOrigWord
241         Remove
243     # Generate sound if wanted
244     select Pitch 'theWord$'
245     if rindex_regex(whatToGenerate$, "Sound") > 0
246             noprogress To Sound (hum)
247     endif
249     # Clean up
250     select PitchTier 'theWord$'
251     if rindex_regex(whatToGenerate$, "Sound") > 0
252         plus Pitch 'theWord$'
253     endif
254     Remove
255 endproc
257 # Get a list of items
258 if createToneList = 1
259     Create Table with column names... ToneList 36 Word
261     for i from 1 to 36
262             select Table ToneList
263         Set string value... 'i' Word ------EMPTY
264     endfor
265 endif
267 syllableCount = length(replace_regex$(inputWord$, "[^\d]+([\d]+)", "1", 0))
268 wordNumber = 0
269 lowerBound = 1
270 if syllableCount = 1
271      lowerBound = 0
272 endif
273 if rindex(generate$, "Correct") <= 0
274     for first from lowerBound to 6
275             currentWord$ = replace_regex$(inputWord$, "^([^\d]+)([\d]+)(.*)$", "\1'first'\3", 1)
276             for second from 0 to 6
277                     if (first <> 5 and second <> 5) and (syllableCount > 1 or second == 1)
278                             currentWord$ = replace_regex$(currentWord$, "^([^\d]+)([\d]+)([^\d]+)([\d]+)$", "\1'first'\3'second'", 1)
279                 # Write name in list
280                 wordNumber = wordNumber+1
281                 if createToneList = 1
282                         select Table ToneList
283                     listLength = Get number of rows
284                     listLength = listLength + 1
285                     for currLength from listLength to wordNumber
286                         Append row
287                         Set string value... 'currLength' Word ------EMPTY
288                     endfor
289                     Set string value... 'wordNumber' Word 'currentWord$'
290                 endif
292                 # Actually, generate something
293                 call generateWord 'generate$' 'currentWord$' 'upperRegister'
294                     endif
295             endfor
296     endfor
297 else
298     call generateWord 'generate$' 'inputWord$' 'upperRegister'
299 endif