PageRenderTime 49ms CodeModel.GetById 19ms RepoModel.GetById 1ms app.codeStats 0ms

/tags/v2-45/mh/lib/Voice_Text.pm

#
Perl | 308 lines | 171 code | 31 blank | 106 comment | 36 complexity | ea2036936515ced72ec954084b2a6041 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, GPL-3.0 
    

  1. 

  2. package Voice_Text;
    3. 

  3. use strict;
    4. 

  4. 

  5. my ($VTxt, $VTxt_festival, $VV_TTS, $save_mute_esd, $save_change_volume, %pronouncable);
    6. 

  6. my ($ViaVoiceTTS); #mod for ViaVoiceTTS
    7. 

  7. 

  8. sub init {
    9. 

  9. 

  10.     if ($main::config_parms{voice_text} =~ /festival/i) {
    11. 

  11.         print "Creating festival TTS socket\n";
    12. 

  12.         my $festival_address = "$main::config_parms{festival_host}:$main::config_parms{festival_port}";
    13. 

  13.         $VTxt_festival = new  Socket_Item(undef, undef, $festival_address);
    14. 

  14.         start $VTxt_festival;
    15. 

  15.         if ($main::config_parms{festival_init_cmds}) {
    16. 

  16.             print "Data sent to festival: $main::config_parms{festival_init_cmds}\n";
    17. 

  17.             set $VTxt_festival qq[$main::config_parms{festival_init_cmds}];
    18. 

  18.         }
    19. 

  19.     }
    20. 

  20.     if ($main::config_parms{voice_text} =~ /vv_tts/i) {
    21. 

  21.         my $pgm_root = $main::Pgm_Root;
    22. 

  22.         $VV_TTS = qq[$main::Pgm_Path/vv_tts.pl];
    23. 

  23.         $VV_TTS .= " -prescript " . $main::config_parms{vv_tts_prescript} if $main::config_parms{vv_tts_prescript};
    24. 

  24.         $VV_TTS .= " -postscript " . $main::config_parms{vv_tts_postscript} if $main::config_parms{vv_tts_postscript};
    25. 

  25.         $VV_TTS .= " -playcmd " . $main::config_parms{vv_tts_playcmd} if $main::config_parms{vv_tts_playcmd};
    26. 

  26.         $VV_TTS .= " -default_sound " . $main::config_parms{vv_tts_default_sound} if $main::config_parms{vv_tts_default_sound};
    27. 

  27.         print "VV TTS command string: $VV_TTS\n";
    28. 

  28.     }
    29. 

  29. 

  30.     if ($main::config_parms{voice_text} =~ /viavoice/i) {
    31. 

  31.       $ViaVoiceTTS = 1;     #define $ViaVoiceTTS if 'voice_text=viavoice'
    32. 

  32.       print "Using ViaVoiceTTS.pm for speech.\n";  
    33. 

  33.     }
    34. 

  34. 

  35.     if ($main::config_parms{voice_text} =~ /ms/i and $main::OS_win) {
    36. 

  36.         print "Creating MS TTS object\n";
    37. 

  37. #       $VTxt = CreateObject OLE 'Speech.VoiceText';
    38. 

  38.         $VTxt = Win32::OLE->new('Speech.VoiceText');
    39. 

  39.         unless ($VTxt) {
    40. 

  40.             print "\n\nError, could not create Speech TTS object.  ", Win32::OLE->LastError(), "\n\n";
    41. 

  41.             return;
    42. 

  42.         }
    43. 

  43.         
    44. 

  44. #       print "Registering the MS TTS object\n";
    45. 

  45.         $VTxt->Register("Local PC", "perl voice_text.pm");
    46. 

  46. #       print "Setting speed\n";
    47. 

  47. #       $VTxt->{Enabled} = 1;
    48. 

  48. #       my $speed_old = $VTxt->{'Speed'};
    49. 

  49.     }
    50. 

  50.     return $VTxt;
    51. 

  51. }
    52. 

  52. 

  53. sub speak_text {
    54. 

  54.     my(%parms) = @_;
    55. 

  55.     my $pgm_root = $main::Pgm_Root;
    56. 

  56.     
    57. 

  57.     $parms{text} = force_pronounce($parms{text}) if %pronouncable;
    58. 

  58. 

  59.     unless ($VTxt or $VV_TTS or $VTxt_festival or $ViaVoiceTTS) {
    60. 

  60.         unless ($main::config_parms{voice_text}) {
    61. 

  61.             print "Can not speak.  mh.ini entry for voice_text is disabled. Phrase=$parms{text}\n";
    62. 

  62.         } else {
    63. 

  63.             print "Can not speak.  Voice_Text object failed to create. Phrase=$parms{text}\n";
    64. 

  64.         }
    65. 

  65.         return;
    66. 

  66.     }
    67. 

  67. 

  68.     if ($VTxt_festival) {
    69. 

  69. #<SABLE>
    70. 

  70. #<SPEAKER NAME="male1">
    71. 

  71. #<VOLUME LEVEL="loud">
    72. 

  72. #<RATE SPEED="-10%">
    73. 

  73. # text
    74. 

  74. #</RATE>
    75. 

  75. #</VOLUME>
    76. 

  76. #</SPEAKER>
    77. 

  77. #</SABLE>
    78. 

  78.         if ($parms{voice} or $parms{volume} or $parms{rate}) {
    79. 

  79.             my $prefix = qq[<SABLE>];
    80. 

  80.             my $suffix = qq[</SABLE>];
    81. 

  81.             if ($parms{voice}) {
    82. 

  82.                 $prefix .= qq[<SPEAKER NAME="$parms{voice}">];
    83. 

  83.                 $suffix = qq[</SPEAKER>] . $suffix;
    84. 

  84.             }
    85. 

  85.             if ($parms{volume}) {
    86. 

  86.                 $prefix .= qq[<VOLUME LEVEL="$parms{volume}">];
    87. 

  87.                 $suffix = qq[</VOLUME>]. $suffix;
    88. 

  88.             }
    89. 

  89.             if ($parms{rate}) {
    90. 

  90.                 $prefix .= qq[<RATE SPEED="$parms{rate}">];
    91. 

  91.                 $suffix = qq[</RATE>] . $suffix;
    92. 

  92.             }
    93. 

  93.             $parms{text} = $prefix . $parms{text} . $suffix;
    94. 

  94.         }
    95. 

  95.         print "Data sent to festival: $parms{text}\n";
    96. 

  96.         set $VTxt_festival qq[(SayText "$parms{text}")];
    97. 

  97.     }
    98. 

  98. 

  99.     if ($VV_TTS) {
    100. 

  100.         my $self = {};
    101. 

  101.         my $pid = fork;
    102. 

  102.         $SIG{CHLD}  = "IGNORE";                   # eliminate zombies created by FORK()
    103. 

  103.         if ($pid) {
    104. 

  104.             $$self{pid} = $pid;
    105. 

  105.         } elsif (defined $pid) {
    106. 

  106.             my $vv_tts_arg = "";;
    107. 

  107.             if ($parms{play}) {
    108. 

  108.                 if ($parms{play} =~ /^System/ or $parms{play} =~ /^[\\\/]/ or $parms{play} =~ /^\S\:/) {
    109. 

  109.                     $vv_tts_arg .= " -play $parms{play} ";
    110. 

  110.                 } else {
    111. 

  111.                     $vv_tts_arg .= " -play $main::config_parms{sound_dir}/$parms{play} ";
    112. 

  112.                 }
    113. 

  113.             }
    114. 

  114.             if ($parms{text}) {
    115. 

  115.                 $vv_tts_arg .= " -text '$parms{text}'";
    116. 

  116.             }
    117. 

  117.             print "db start TTS: $VV_TTS $vv_tts_arg\n" if $main::config_parms{debug} eq 'voice';
    118. 

  118.             exec qq[$VV_TTS $vv_tts_arg];
    119. 

  119.             die 'cant exec $VV_TTS';
    120. 

  120.         }
    121. 

  121.     }
    122. 

  122. 

  123.     if ($ViaVoiceTTS) {
    124. 

  124.         $SIG{CHLD}  = "IGNORE";        # eliminate zombies created by FORK()
    125. 

  125. FORK:                                  # straight out of the book
    126. 

  126.         if (my $pid=fork) {            # if forked ok
    127. 

  127.             # Parent's code
    128. 

  128.             print "$parms{text} sent to $pid\n";
    129. 

  129.         } elsif (defined $pid) {
    130. 

  130.             # child's code here
    131. 

  131.             my $prog = <<ProgCode;
    132. 

  132. use ViaVoiceTTS;
    133. 

  133. my \$tts = new ViaVoiceTTS();
    134. 

  134. ViaVoiceTTS::speak \$tts,"$parms{text}";
    135. 

  135. exit 0;
    136. 

  136. ProgCode
    137. 

  137.             exec "echo '$prog' | $^X ";   # pipe prog to perl
    138. 

  138.             die "ViaVoiceTTS child died"; # This statement should not be reached
    139. 

  139.         } elsif ($! =~ /No more process/) {
    140. 

  140.             # EAGAIN, supposedly recoverable fork error
    141. 

  141.             sleep 2;
    142. 

  142.             redo FORK;
    143. 

  143.         } else {
    144. 

  144.             # weird fork error
    145. 

  145.             die "Can't fork: $!\n";
    146. 

  146.         }
    147. 

  147.     }
    148. 

  148. 

  149.     if ($VTxt) {
    150. 

  150.         
    151. 

  151.         # Turn off vr while speaking ... SB live card will listen while speaking!
    152. 

  152.         #  - this doesn't work.  TTS does not start right away.  Best to poll in Voice_Cmd
    153. 

  153. #       &Voice_Cmd::deactivate;
    154. 

  154. 

  155.         my(%priority) = ('normal' => hex(200), 'high' => hex(100), 'veryhigh' => hex(80));
    156. 

  156.         my(%type)     = ('statement' => hex(1), 'question' => hex(2), 'command' => hex(4),
    157. 

  157.                          'warning'   => hex(8), 'reading'  => hex(10), 'numbers' => hex(20),
    158. 

  158.                          'spreadsheet'   => hex(40));
    159. 

  159.         $parms{type} = 'statement'  unless $parms{'type'};
    160. 

  160.         $parms{speed} = 170         unless $parms{'speed'};
    161. 

  161.         $parms{priority} = 'normal' unless $parms{priority};
    162. 

  162.         $priority{$parms{'priority'}} = $parms{'priority'} if $parms{'priority'} =~ /\d+/; # allow for direct parm
    163. 

  163.         
    164. 

  164. #       $VTxt->{'Speed'} = $parms{'speed'} if defined $parms{'speed'};
    165. 

  165.         my ($priority, $type, $voice);
    166. 

  166.         $priority = $priority{$parms{'priority'}};
    167. 

  167.         $type = $type{$parms{'type'}};
    168. 

  168.                                 # Unfortunatly, the voice controls do not work with the 
    169. 

  169.                                 # '95 vintage Centigram text->speech engine :(
    170. 

  170. #           print "priority=$priority type=$type flag=", $priority | $type, "\n";
    171. 

  171.         $voice = qq[\\Vce=Speaker="$parms{voice}"\\] if $parms{voice};
    172. 

  172.         $voice = '' unless $voice;
    173. 

  173. #           $voice = q[\Chr="Angry"\\];
    174. 

  174. #           $voice = q[\\\\Vol=2222\\\\];
    175. 

  175. #           $voice = q[\\VOL=2222\\];
    176. 

  176. #           $voice = q[/Vol=2222/];
    177. 

  177. #           print "text=$parms{'text'}\n";
    178. 

  178. #           print "voice=$voice\n";
    179. 

  179. 

  180. #           $VTxt->Speak($voice . $parms{'text'}, ($priority | $type));
    181. 

  181. #           $VTxt->Speak($voice . $parms{'text'}, $priority, "Vce=Speaker=Biff")
    182. 

  182. #           print "Sending text to Speak object with voice=$voice type=$type, prioirty=$priority ...";
    183. 

  183. #           $VTxt->Speak($voice . $parms{'text'}, $priority, $voice);
    184. 

  184. #           $VTxt->Speak($voice . $parms{'text'}, $priority);
    185. 

  185. #           $VTxt->Speak($voice . $parms{'text'}, $type, $priority);
    186. 

  186. 

  187.         print "Voice_Text.pm ms_tts: VTxt=$VTxt text=$parms{'text'}\n" if $main::config_parms{debug} eq 'voice';
    188. 

  188.         $VTxt->Speak($voice . $parms{'text'}, $priority);
    189. 

  189. 

  190. #           $VTxt->Speak($parms{'text'}, ($priority | $type));
    191. 

  191. #           $VTxt->Speak('Hello \Chr="Angry"\ there. Bruce is \Vce=Speaker=Biff\ a very smart idiot guy.', hex('201'));
    192. 

  192. 

  193.                                 # From Agent SpeechOutputTags2zip.doc
    194. 

  194. #   Chr=Normal,Monotone,Whisper
    195. 

  195. #   Ctx=Address,Email,Unknow
    196. 

  196. #   Emp  (Emphasizes the next word
    197. 

  197. #   Pau=number (pauses for number of milliseconds from 10 to 2550 (.01 to 2.55 seconds)
    198. 

  198. #   Pit=number (Sets the baseline pitch in hertz (from 50 to 400)
    199. 

  199. #   Rst  Resets all tags
    200. 

  200. #   Spd=number  Speed from 50 to 250
    201. 

  201. #   Vol=number  Volume from 0 to 65535
    202. 

  202. 

  203. # More Control tags are at the end of Speeck SDK lowtts.doc
    204. 

  204. 

  205.     }
    206. 

  206. }
    207. 

  207. 

  208. sub is_speaking {
    209. 

  209.     return unless $VTxt;
    210. 

  210.     return $VTxt->{IsSpeaking};
    211. 

  211. }
    212. 

  212. 

  213.                                 # This has been moved to mh.  Leave this stub in so 
    214. 

  214.                                 # we don't break old user code
    215. 

  215. sub last_spoken {
    216. 

  216.     my ($how_many) = @_;
    217. 

  217.     &main::speak_log_last($how_many);
    218. 

  218. }
    219. 

  219. 

  220.     
    221. 

  221. sub read_pronouncable_list {
    222. 

  222.     my($pronouncable_list_file) = @_;
    223. 

  223. 

  224.     my ($phonemes, $word, $cnt);
    225. 

  225. 

  226.     open (WORDS, $pronouncable_list_file) or print "\nError, could not find the pronouncable word file $pronouncable_list_file: $!\n"; 
    227. 

  227. 

  228.     undef %pronouncable;
    229. 

  229.     while (<WORDS>) {
    230. 

  230.         next if /^\#/;
    231. 

  231.         ($word, $phonemes) = $_ =~ /^(\S+)\s+(.+)\s*$/;
    232. 

  232.         next unless $word;
    233. 

  233.         $cnt++;
    234. 

  234.         $pronouncable{$word} = $phonemes;
    235. 

  235.     }
    236. 

  236.     print "Read $cnt entries from $pronouncable_list_file\n";
    237. 

  237.     close WORDS;
    238. 

  238. }
    239. 

  239. 

  240. sub force_pronounce {
    241. 

  241.     my($phrase) = @_;
    242. 

  242.     print "input  phrase is '$phrase'\n" if $main::config_parms{debug} eq 'voice';
    243. 

  243.     for my $word (keys %pronouncable) {
    244. 

  244.         $phrase =~ s/\b$word\b/$pronouncable{$word}/gi;
    245. 

  245.     }
    246. 

  246.     print "output phrase is '$phrase'\n" if $main::config_parms{debug} eq 'voice';
    247. 

  247.     return $phrase;
    248. 

  248. }
    249. 

  249.     
    250. 

  250. 1;
    251. 

  251. 

  252. #
    253. 

  253. # $Log$
    254. 

  254. # Revision 1.23  2001/02/24 23:26:40  winter
    255. 

  255. # - 2.45 release
    256. 

  256. #
    257. 

  257. # Revision 1.22  2001/02/04 20:31:31  winter
    258. 

  258. # - 2.43 release
    259. 

  259. #
    260. 

  260. # Revision 1.21  2000/09/09 21:19:11  winter
    261. 

  261. # - 2.28 release
    262. 

  262. #
    263. 

  263. # Revision 1.20  2000/08/19 01:22:36  winter
    264. 

  264. # - 2.27 release
    265. 

  265. #
    266. 

  266. # Revision 1.19  2000/05/06 16:34:32  winter
    267. 

  267. # - 2.15 release
    268. 

  268. #
    269. 

  269. # Revision 1.18  2000/04/09 18:03:19  winter
    270. 

  270. # - 2.13 release
    271. 

  271. #
    272. 

  272. # Revision 1.17  2000/02/20 04:47:55  winter
    273. 

  273. # -2.01 release
    274. 

  274. #
    275. 

  275. # Revision 1.16  2000/01/27 13:44:27  winter
    276. 

  276. # - update version number
    277. 

  277. #
    278. 

  278. # Revision 1.15  2000/01/13 13:39:52  winter
    279. 

  279. # - added mixer_settings and vvo_stuff (added 2 weeks ago)
    280. 

  280. #
    281. 

  281. # Revision 1.12  1999/10/09 20:38:37  winter
    282. 

  282. # - add max_log_entries check
    283. 

  283. #
    284. 

  284. # Revision 1.11  1999/05/30 21:08:55  winter
    285. 

  285. # - change TDstamp format in log
    286. 

  286. #
    287. 

  287. # Revision 1.10  1999/02/21 00:27:17  winter
    288. 

  288. # - use $OS_win
    289. 

  289. #
    290. 

  290. # Revision 1.9  1999/02/04 14:21:28  winter
    291. 

  291. # - switch to new OLE calls.  Add better error checking
    292. 

  292. #
    293. 

  293. # Revision 1.8  1999/01/22 02:43:21  winter
    294. 

  294. # - add Festival support.
    295. 

  295. #
    296. 

  296. # Revision 1.7  1999/01/10 02:29:50  winter
    297. 

  297. # - give better 'tts engine disabled' messages
    298. 

  298. #
    299. 

  299. # Revision 1.6  1999/01/09 21:43:14  winter
    300. 

  300. # - improve ole fail error
    301. 

  301. #
    302. 

  302. # Revision 1.5  1999/01/07 01:55:03  winter
    303. 

  303. # - Limit size of Spoken_Text array
    304. 

  304. #
    305. 

  305. # Revision 1.4  1998/12/08 02:26:07  winter
    306. 

  306. # - add log
    307. 

  307. #
    308. 

  308. #
    309. 

  309.