tolmega01
August 7th, 2009, 12:45 PM
'(*=========================================
'SPEAKPHRASE
'Send text out to DECtalk NT.
'=========================================*)
'PROCEDURE SPEAKPHRASE;
Public sub SPEAKPHRASE() as string
dim i,j,charin,outcount,settlen,comm_tx,comm_rx,flush as integer
dim started,charsok,speaking_text,changing_voice as boolean
start_pitch:str20;
trytxt:str255;
'BEGIN { speakphrase }
punc_tx=0
punc_rx=0
comm_tx=0
comm_rx=0
IF outtxt="PHONEME ARRAY" THEN speaking_text=false
ELSE speaking_text=true
IF copy(outtxt,1,2)="(:" THEN changing_voice=true
ELSE changing_voice=false
IF NOT speaking_text THEN '{ * Speak phoneme array * }
trytxt="" '{ Check phonemes are valid }
charsok=false
FOR i=phon_start TO phon_fin
trytxt=trytxt+phon_name(i)
IF length(trytxt)>1 THEN FOR i=1 TO length(trytxt)
IF trytxt(i) in ("A".."Z","a".."z") THEN charsok=true
IF charsok AND (phon_fin-phon_start>1) THEN BEGIN { Phons OK? }
outtxt=phon_name(phon_fin) { Process last phoneme }
while (i=length(outtxt))
do
IF outtxt(i)=space THEN
outtxt=copy(outtxt,1,i-1)
dec(i)
END
loop (i=1) OR (outtxt(i)<>space)
IF NOT (outtxt(i) in (".","!","?",")")) THEN
outtxt=outtxt+"."
phon_name(phon_fin)=outtxt '{ Copy it back to array }
FOR i=phon_start TO phon_fin DO '{ Count ">" terminators }
FOR j=1 TO length(phon_name(i))
IF phon_name(i)(j)=">" THEN inc(punc_tx)
str(phon_pitch(phon_start),start_pitch) { Add start + end }
phon_name(phon_start-1)="(_<10,"+start_pitch+">) ("
phon_name(phon_fin+1)=")"
i=phon_start-1 { Add in returns }
outcount=0
while
outcount=outcount+length(phon_name(i))
IF (outcount>65) AND (phon_num(i) in phons) THEN
phon_name(i)=phon_name(i)+#13+#10
outcount=0
END
inc(i)
UNTIL i=phon_fin
IF (saving) THEN
settlen=0
FOR i=1 TO 3 DO IF length(sett_rule(i))>0 THEN BEGIN
FOR j=1 TO length(sett_rule(i)) DO { Make lower case }
IF sett_rule(i)(j) in ("A".."Z") THEN
sett_rule(i)(j)=chr(ord(sett_rule(i)(j))+32)
write(fileout,sett_rule(i))
settlen=settlen+length(sett_rule(i))
END
IF settlen>0 THEN writeln(fileout)
FOR i=phon_start-1 TO phon_fin+1 DO
write(fileout,phon_name(i))
END
ELSE IF synth_avail THEN BEGIN
IF NOT prog_version THEN FOR i=phon_start-1 TO phon_fin+1 DO write(phon_name(i),space)
IF NOT prog_version THEN writeln
writeln(fileout,"(:phoneme arpabet on)")
FOR i=phon_start-1 TO phon_fin+1 DO
FOR j=1 TO length(phon_name(i)) DO BEGIN
write(fileout,phon_name(i)(j))
END
writeln(fileout)
writeln(fileout,"(:phoneme arpabet off)")
IF speaknow THEN
close(fileout) { Close file and speak }
swapvectors
EXEC(dirsystem,"/C SAY < "+dirtemp+"\HAMLET.TXT")
EXEC(dirsystem,"/C COPY "+dirtemp+"\HAMLET.TXT "+dirtemp+"\HAMLPREV.TXT > NUL")
IF doserror<>0 then writeln("DOS error",doserror)
swapvectors { Reopen file }
assign(fileout,dirtemp+"\HAMLET.TXT")
rewrite(fileout)
END
END
END
END { * Speak phoneme array * }
ELSE BEGIN { * Speak normal text string * }
REPEAT
i=length(outtxt)
IF outtxt(i)=space THEN BEGIN
outtxt=copy(outtxt,1,i-1)
dec(i)
END
UNTIL (i=1) OR (outtxt(i)<>space) { Add "." if required }
IF (NOT (outtxt(i) in (".","!","?",")")) AND
(NOT (copy(outtxt,1,2)="(:"))) THEN outtxt=outtxt+"."
IF synth_avail THEN BEGIN
IF saving THEN writeln(fileout,"(:log phonemes on)")
writeln(fileout,outtxt)
IF saving THEN writeln(fileout,"(:log phonemes off)")
IF speaknow THEN BEGIN
close(fileout)
swapvectors
EXEC(dirsystem,"/C SAY < "+dirtemp+"\HAMLET.TXT")
EXEC(dirsystem,"/C COPY "+dirtemp+"\HAMLET.TXT "+dirtemp+"\HAMLPREV.TXT > NUL")
IF doserror<>0 then writeln("DOS error",doserror)
swapvectors
assign(fileout,dirtemp+"\HAMLET.TXT")
rewrite(fileout)
END
END
END { * Speak normal text string * }
END { speakphrase }
'(*==============================================
'SPEAK PHONEMES TO DECTALK
'Procedure to speak standard phoneme arrays to DECtalk synthesiser.
'Phoneme strings in array phon_str
'Phoneme numbers in array phon_num
'Phoneme pitches in array phon_pitch
'Phoneme durations in array phon_dur
'==============================================*)
'PROCEDURE SPEAK_PHONEMES_TO_DECTALK
Public sub SPEAK_PHONEMES_TO_DECTALK() as string
dim i as integer
'BEGIN { speak phonemes to dectalk }
vowel_total=0
FOR i=1 TO phon_total
IF phon_num(i) in vowels THEN inc(vowel_total)
synth_vox=1
voice_init
phon_start=1
phon_fin=phon_total-1
'(*
full_info=false
demo_mode=false
do_dd_rules=true
do_pd_rules=true
'*)
'{ set_duration_defaults(180,false) }
'{ set_pitch_defaults(false) }
synth_avail=true
add_in_values
speakphrase(false,true,"PHONEME ARRAY")
end sub '{ speak phonemes to dectalk }
'(*=========================================
'ADD IN VALUES
'Change phoneme durations and pitches from integer to string,
'and add to phoneme strings.
'=========================================*)
'PROCEDURE ADD_IN_VALUES
Public sub ADD_IN_VALUES() as string
i,j,vptr:integer
pitch,oldpitch,duration:str20
BEGIN { add in values }
dur_total=0
max_pitch=0
FOR i=2 TO phon_total DO ' { Eliminate non-phoneme params }
IF (phon_num(i) in nonphons) AND NOT (phon_num(i)=silence) THEN
IF phon_num(i) in stress THEN phon_name(i)=""
ELSE
phon_pitch(i)=phon_pitch(i-1)
phon_dur(i)=0
END
IF phon_num(1) in nonphons THEN BEGIN ' { Process initial non-phonemes }
i=1
WHILE phon_num(i+1) in nonphons DO inc(i)
FOR j=i DOWNTO 1
phon_pitch(j)=phon_pitch(j+1)
phon_dur(j)=0
END
END
oldpitch="0"
FOR i=phon_start TO phon_fin
IF vibrato THEN ' { Add vibrato effects }
vptr=1
WHILE phon_pitch(i)>vtone(vptr) DO inc(vptr)
str(vptr,pitch)
END
ELSE str(phon_pitch(i),pitch)
str(phon_dur(i),duration)
IF (((phon_dur(i)>0) OR (pitch<>oldpitch)) AND NOT
((i=phon_start) AND (phon_num(i) in nonphons))) THEN
phon_name(i)=phon_name(i)+"<"
IF (phon_dur(i)>0) THEN phon_name(i)=phon_name(i)+duration
IF phon_num(i) in phons THEN BEGIN '{ Add pitch if normal phon }
IF pitch<>oldpitch THEN '{ .. and pitch changed }
phon_name(i)=phon_name(i)+","+pitch
oldpitch=pitch
END
IF (((phon_dur(i)>0) OR (pitch<>oldpitch)) AND NOT
((i=phon_start) AND (phon_num(i) in nonphons))) THEN
phon_name(i)=phon_name(i)+">"
dur_total=dur_total+phon_dur(i)
IF phon_num(i)=punc_strt THEN phon_name(i)="_<250>" { Comma }
IF phon_pitch(i)>max_pitch THEN max_pitch=phon_pitch(i)
END
end sub
'END { add in values }
'SPEAKPHRASE
'Send text out to DECtalk NT.
'=========================================*)
'PROCEDURE SPEAKPHRASE;
Public sub SPEAKPHRASE() as string
dim i,j,charin,outcount,settlen,comm_tx,comm_rx,flush as integer
dim started,charsok,speaking_text,changing_voice as boolean
start_pitch:str20;
trytxt:str255;
'BEGIN { speakphrase }
punc_tx=0
punc_rx=0
comm_tx=0
comm_rx=0
IF outtxt="PHONEME ARRAY" THEN speaking_text=false
ELSE speaking_text=true
IF copy(outtxt,1,2)="(:" THEN changing_voice=true
ELSE changing_voice=false
IF NOT speaking_text THEN '{ * Speak phoneme array * }
trytxt="" '{ Check phonemes are valid }
charsok=false
FOR i=phon_start TO phon_fin
trytxt=trytxt+phon_name(i)
IF length(trytxt)>1 THEN FOR i=1 TO length(trytxt)
IF trytxt(i) in ("A".."Z","a".."z") THEN charsok=true
IF charsok AND (phon_fin-phon_start>1) THEN BEGIN { Phons OK? }
outtxt=phon_name(phon_fin) { Process last phoneme }
while (i=length(outtxt))
do
IF outtxt(i)=space THEN
outtxt=copy(outtxt,1,i-1)
dec(i)
END
loop (i=1) OR (outtxt(i)<>space)
IF NOT (outtxt(i) in (".","!","?",")")) THEN
outtxt=outtxt+"."
phon_name(phon_fin)=outtxt '{ Copy it back to array }
FOR i=phon_start TO phon_fin DO '{ Count ">" terminators }
FOR j=1 TO length(phon_name(i))
IF phon_name(i)(j)=">" THEN inc(punc_tx)
str(phon_pitch(phon_start),start_pitch) { Add start + end }
phon_name(phon_start-1)="(_<10,"+start_pitch+">) ("
phon_name(phon_fin+1)=")"
i=phon_start-1 { Add in returns }
outcount=0
while
outcount=outcount+length(phon_name(i))
IF (outcount>65) AND (phon_num(i) in phons) THEN
phon_name(i)=phon_name(i)+#13+#10
outcount=0
END
inc(i)
UNTIL i=phon_fin
IF (saving) THEN
settlen=0
FOR i=1 TO 3 DO IF length(sett_rule(i))>0 THEN BEGIN
FOR j=1 TO length(sett_rule(i)) DO { Make lower case }
IF sett_rule(i)(j) in ("A".."Z") THEN
sett_rule(i)(j)=chr(ord(sett_rule(i)(j))+32)
write(fileout,sett_rule(i))
settlen=settlen+length(sett_rule(i))
END
IF settlen>0 THEN writeln(fileout)
FOR i=phon_start-1 TO phon_fin+1 DO
write(fileout,phon_name(i))
END
ELSE IF synth_avail THEN BEGIN
IF NOT prog_version THEN FOR i=phon_start-1 TO phon_fin+1 DO write(phon_name(i),space)
IF NOT prog_version THEN writeln
writeln(fileout,"(:phoneme arpabet on)")
FOR i=phon_start-1 TO phon_fin+1 DO
FOR j=1 TO length(phon_name(i)) DO BEGIN
write(fileout,phon_name(i)(j))
END
writeln(fileout)
writeln(fileout,"(:phoneme arpabet off)")
IF speaknow THEN
close(fileout) { Close file and speak }
swapvectors
EXEC(dirsystem,"/C SAY < "+dirtemp+"\HAMLET.TXT")
EXEC(dirsystem,"/C COPY "+dirtemp+"\HAMLET.TXT "+dirtemp+"\HAMLPREV.TXT > NUL")
IF doserror<>0 then writeln("DOS error",doserror)
swapvectors { Reopen file }
assign(fileout,dirtemp+"\HAMLET.TXT")
rewrite(fileout)
END
END
END
END { * Speak phoneme array * }
ELSE BEGIN { * Speak normal text string * }
REPEAT
i=length(outtxt)
IF outtxt(i)=space THEN BEGIN
outtxt=copy(outtxt,1,i-1)
dec(i)
END
UNTIL (i=1) OR (outtxt(i)<>space) { Add "." if required }
IF (NOT (outtxt(i) in (".","!","?",")")) AND
(NOT (copy(outtxt,1,2)="(:"))) THEN outtxt=outtxt+"."
IF synth_avail THEN BEGIN
IF saving THEN writeln(fileout,"(:log phonemes on)")
writeln(fileout,outtxt)
IF saving THEN writeln(fileout,"(:log phonemes off)")
IF speaknow THEN BEGIN
close(fileout)
swapvectors
EXEC(dirsystem,"/C SAY < "+dirtemp+"\HAMLET.TXT")
EXEC(dirsystem,"/C COPY "+dirtemp+"\HAMLET.TXT "+dirtemp+"\HAMLPREV.TXT > NUL")
IF doserror<>0 then writeln("DOS error",doserror)
swapvectors
assign(fileout,dirtemp+"\HAMLET.TXT")
rewrite(fileout)
END
END
END { * Speak normal text string * }
END { speakphrase }
'(*==============================================
'SPEAK PHONEMES TO DECTALK
'Procedure to speak standard phoneme arrays to DECtalk synthesiser.
'Phoneme strings in array phon_str
'Phoneme numbers in array phon_num
'Phoneme pitches in array phon_pitch
'Phoneme durations in array phon_dur
'==============================================*)
'PROCEDURE SPEAK_PHONEMES_TO_DECTALK
Public sub SPEAK_PHONEMES_TO_DECTALK() as string
dim i as integer
'BEGIN { speak phonemes to dectalk }
vowel_total=0
FOR i=1 TO phon_total
IF phon_num(i) in vowels THEN inc(vowel_total)
synth_vox=1
voice_init
phon_start=1
phon_fin=phon_total-1
'(*
full_info=false
demo_mode=false
do_dd_rules=true
do_pd_rules=true
'*)
'{ set_duration_defaults(180,false) }
'{ set_pitch_defaults(false) }
synth_avail=true
add_in_values
speakphrase(false,true,"PHONEME ARRAY")
end sub '{ speak phonemes to dectalk }
'(*=========================================
'ADD IN VALUES
'Change phoneme durations and pitches from integer to string,
'and add to phoneme strings.
'=========================================*)
'PROCEDURE ADD_IN_VALUES
Public sub ADD_IN_VALUES() as string
i,j,vptr:integer
pitch,oldpitch,duration:str20
BEGIN { add in values }
dur_total=0
max_pitch=0
FOR i=2 TO phon_total DO ' { Eliminate non-phoneme params }
IF (phon_num(i) in nonphons) AND NOT (phon_num(i)=silence) THEN
IF phon_num(i) in stress THEN phon_name(i)=""
ELSE
phon_pitch(i)=phon_pitch(i-1)
phon_dur(i)=0
END
IF phon_num(1) in nonphons THEN BEGIN ' { Process initial non-phonemes }
i=1
WHILE phon_num(i+1) in nonphons DO inc(i)
FOR j=i DOWNTO 1
phon_pitch(j)=phon_pitch(j+1)
phon_dur(j)=0
END
END
oldpitch="0"
FOR i=phon_start TO phon_fin
IF vibrato THEN ' { Add vibrato effects }
vptr=1
WHILE phon_pitch(i)>vtone(vptr) DO inc(vptr)
str(vptr,pitch)
END
ELSE str(phon_pitch(i),pitch)
str(phon_dur(i),duration)
IF (((phon_dur(i)>0) OR (pitch<>oldpitch)) AND NOT
((i=phon_start) AND (phon_num(i) in nonphons))) THEN
phon_name(i)=phon_name(i)+"<"
IF (phon_dur(i)>0) THEN phon_name(i)=phon_name(i)+duration
IF phon_num(i) in phons THEN BEGIN '{ Add pitch if normal phon }
IF pitch<>oldpitch THEN '{ .. and pitch changed }
phon_name(i)=phon_name(i)+","+pitch
oldpitch=pitch
END
IF (((phon_dur(i)>0) OR (pitch<>oldpitch)) AND NOT
((i=phon_start) AND (phon_num(i) in nonphons))) THEN
phon_name(i)=phon_name(i)+">"
dur_total=dur_total+phon_dur(i)
IF phon_num(i)=punc_strt THEN phon_name(i)="_<250>" { Comma }
IF phon_pitch(i)>max_pitch THEN max_pitch=phon_pitch(i)
END
end sub
'END { add in values }