package PerlSpeak; use 5.006; use strict; use warnings; use POSIX qw(:termios_h); use IO::Socket; use vars qw($VERSION); $VERSION = '2.01'; sub new { my $pkg = shift; my $self = { "tts_engine" => "festival_pipe", "tts_command" => "", "tts_file_command" => "", "file2wave_command" => "", "make_readable" => "[_\/]", "no_dot_files" => 1, "hide_extentions" => 0, "browsable" => 1, "dir_return" => 1, "file_prefix" => "File", "dir_prefix" => "Folder", "echo_off" => 0, "voice" => "kal_diphone", "rate" => 1, "volume" => 1, "pitch" => 50, "lang" => "en", @_}; return bless $self, $pkg; } sub say { my $self = shift; my $arg = shift; my $rep = shift || " "; chomp $arg; print "\n$arg\n" unless $self->{echo_off}; if ($self->{tts_command}){ my $command = $self->{tts_command}; $command =~s/text_arg/\"$arg\"/ ; system $command or die "Error with tts_command"; }elsif ($self->{tts_engine} eq "festival"){ system "echo \"$arg\" | festival --tts"; }elsif ($self->{tts_engine} eq "cepstral"){ system "swift \"$arg\""; }elsif ($self->{tts_engine} eq "espeak"){ $arg =~s/!/\./g; system "echo \"$arg\" | espeak -v $self->{voice} -s $self->{rate} -a $self->{volume} -p $self->{pitch}"; }elsif ($self->{tts_engine} eq "festival_server") { $arg =~ s/[\n\r"]/$rep/g; $self->festival("(let ((utt (Utterance Text \"$arg\"))) (begin ($self->{voice}) (Parameter.set 'Duration_Stretch $self->{rate}) (utt.synth utt) (utt.wave.resample utt 8000) (utt.wave.rescale utt $self->{volume}) (utt.play utt)))\n"); }elsif ($self->{tts_engine} eq "festival_pipe") { return unless $arg; system("echo \"(let ((utt (Utterance Text \\\"$arg\\\"))) (begin ($self->{voice}) (Parameter.set 'Duration_Stretch $self->{rate}) (utt.synth utt) (utt.wave.resample utt 8000) (utt.wave.rescale utt $self->{volume}) (utt.play utt)))\" | festival --pipe"); } } sub festival { my $self = shift; my $arg = shift; return unless $self->{tts_engine} eq "festival_server"; $self->{'handle'}->print("$arg\n"); } sub config_festival { # voice, rate, volume my $self = shift; my $voice = shift; my $rate = shift; my $vol = shift; return $self->config_voice($voice, $rate, $vol); } sub config_voice { # voice, rate, volume, pitch my $self = shift; my $voice = shift; my $rate = shift; my $vol = shift; my $pitch = shift || 50; return 0 unless $self->voice($voice); return 0 unless $self->rate($rate); return 0 unless $self->volume($vol); return 0 unless $self->pitch($pitch); return 1; } sub voice { my $self = shift; my $voice = shift; $self->{voice} = $voice if $voice; return $self->{voice}; } sub pitch { my $self = shift; my $pitch = shift || "50"; $self->{pitch} = $pitch if $pitch; return $self->{pitch}; } sub rate { my $self = shift; my $rate = shift; $self->{rate} = $rate if $rate; return $self->{rate}; } sub volume { my $self = shift; my $vol = shift; $self->{volume} = $vol if $vol; return $self->{volume}; } sub get_voices { my $self = shift; my $line = ""; my @lst = (); my @voice_lst = (); if (($self->{tts_engine} eq "festival_server") || ($self->{tts_engine} eq "festival_pipe")) { return unless $self->{handle}->connected(); die "can't fork: $!" unless defined(my $kidpid = fork()); if ($kidpid) { # parent copies the socket to standard output while ($line !~ /voices/) { $line = $self->{handle}->getline; } $line =~ s/[()\n\r]//g; @lst = split " ", $line; foreach (@lst) { next if /\.|1|voices/; push @voice_lst, $_ if /\w_\w/; } kill("TERM" => $kidpid); # send SIGTERM to child return \@voice_lst; } else { $self->{handle}->print("voice-locations\n"); } } elsif ($self->{tts_engine} eq "espeak") { my @tmp = `espeak --voices=$self->{lang}`; foreach my $line (@tmp) { next if $line =~ /ender/; $line =~ s/^ //; my @word = split /\s/, $line; foreach (@word) { if (/\//) { push @voice_lst, $_; last; } } } return \@voice_lst; } } sub festival_connect { my $self = shift; if ($self->{handle}) { return 1 if $self->{handle}->connected(); } $self->{host} = shift || "127.0.0.1"; $self->{port} = shift || 1314; $self->{handle} = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $self->{host}, PeerPort => $self->{port}) or die " Can't connect to port $self->{port} on $self->{host}: $! (Are you sure the server is running and accepting connections?) "; return $self->{handle}; } sub tts_engine { my $self = shift; if (my $tts = shift) { $self->{tts_engine} = $tts; } return $self->{tts_engine}; } sub readfile { my $self = shift; my $arg = shift; if (-e $arg){ if ($self->{tts_file_command}){ my $command = $self->{tts_file_command}; $command =~s/file_arg/$arg/; system $command; }elsif ($self->{tts_engine} eq "festival"){ system "festival --tts $arg"; }elsif ($self->{tts_engine} eq "cepstral"){ system "$self->{path_to_tts}swift -f $arg"; }elsif ($self->{tts_engine} eq "espeak"){ system "espeak -f $arg"; }elsif (($self->{tts_engine} eq "festival_server") or ($self->{tts_engine} eq "festival_pipe")) { open FH, "$arg" or die "ERROR! Could not open $arg: $!\n"; my $txt = ""; while () { $txt .= $_; } $txt =~ s/[\n\r"`]/ /g; close FH; $self->say($txt); }else { $self->say("ERROR! with tts engine or tts file command.") & die "ERROR! with tts_engine or tts_file_command."; } } else { $self->say("ERROR! $arg is not a file.") & die "ERROR! $arg is not a file."; } } sub file2wave { my $self = shift; my $in = shift; my $out = shift; my $play = shift or 1; if (-e $in){ if ($self->{file2wave_command}){ my $command = $self->{file2wave_command}; $command =~s/IN/$in/; $command =~s/OUT/$out/; system "$command"; } elsif ($self->{tts_engine} eq "festival") { system "text2wave -otype riff -o $out $in"; } elsif ($self->{tts_engine} eq "cepstral") { system "swift -m text -f $in -o $out"; } elsif ($self->{tts_engine} eq "espeak") { print "espeak -f $in -w $out\n"; system "espeak -f $in -w $out"; } elsif ($self->{tts_engine} eq "festival_server") { $self->file2wave_festival($in, $out, " ", $play); } elsif ($self->{tts_engine} eq "festival_pipe") { $self->say("ERROR! TTS engine festival_pipe cannot convert text to wave files. Use TTS engine festival_server instead."); } } else { $self->say("ERROR! $in is not a file.") & die "ERROR! $in is not a file."; } } sub file2wave_festival { my $self = shift; my $in = shift; my $out = shift; my $rep = shift; my $play = shift; $rep = " " unless $rep; my ($host, $port, $kidpid, $handle, $line, $remains, $result); my $wave_type = "riff"; # the type of the audio files my $file_stuff_key = "ft_StUfF_key"; # defined in speech tools # tell the server to send us back a 'file' of the right type $self->festival("(Parameter.set 'Wavefiletype '$wave_type)"); # split the program into two processes, identical twins die "can't fork: $!" unless defined($kidpid = fork()); # the if{} block runs only in the parent process if ($kidpid) { # the parent handles the input so it can exit on quit undef $line; while (($line = $remains) || defined ($line = $self->{handle}->getline())) { undef $remains; if ($line eq "WV\n") { # we have a waveform coming undef $result; if ($out) { open(AUDIO, ">$out"); } else { die "ERROR! No output file argument"; } while ($line = $self->{handle}->getline()) { if ($line =~ s/$file_stuff_key(.*)$//s) { $remains = $1; print AUDIO $line; last; } print AUDIO $line; } close AUDIO; last; } } kill("TERM" => $kidpid); # send SIGTERM to child system("mplayer $out") if $play; } else { my $txt = ""; open FH, "$in" or die "ERROR! Could not open $in: $!\n"; while () { $txt .= $_; } $txt =~ s/[\n\r"]/$rep/g; close FH; $self->festival("(let ((utt (Utterance Text \"$txt\"))) (begin ($self->{voice}) (Parameter.set 'Duration_Stretch $self->{rate}) (utt.synth utt) (utt.wave.resample utt 8000) (utt.wave.rescale utt $self->{volume}) (utt.send.wave.client utt)))"); } } sub menu { my $self = shift; my $count = shift; my @var = @_; if ($#var % 2 == 0) { unshift @var, $count; $count = 0; } my %var_hash = @var; my @keys = sort(keys %var_hash); my $str = ""; my $command = ""; while (not $command){ $self->say($keys[$count]); my $answ = $self->getch(); if (ord($answ)==27){ $str = ""; $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count == scalar(@keys); $count = scalar(@keys) - 1 if $count < 0; } } elsif ((ord($answ)==10) or (ord($answ)==13) or ($answ =~ /[yY]/)){ $command = 1; &{$var_hash{$keys[$count]}}; } elsif (($answ =~ /\d/) and ($str eq "")) { $count = $answ -1; $command = 1; #&{$var_hash{$keys[$count]}}; } elsif ($answ =~ /\w/) { $str .= uc $answ; foreach my $i (0..$#keys) { my $test = uc $keys[$i]; $count = $i and last if ($test =~ /^\d\. $str/); } } } return $count; } sub menu_list { my $self = shift; my @lst = @_; my $count = 0; my $str = ""; while (1) { $self->say($lst[$count]); my $answ = $self->getch(); if (ord($answ)==27){ $str = ""; $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count > $#lst; $count = $#lst if $count < 0; } } elsif ((ord($answ)==10) or (ord($answ)==13) or (ord($answ)==89) or (ord($answ)==121)){ last; } elsif ($answ =~ /\w/) { $str .= lc $answ; $count = 0; foreach (@lst) { my $test = lc $_; if ($test =~ /^$str/) { last; } else { $count++; $count = $#lst if $count > $#lst; } } } } return $lst[$count]; } sub filepicker { my $self = shift; my $d = shift; my $file = ""; my $flter = ""; my $answ = ""; my @tmp = (); my @lst = (); while (not $file) { my $count = 0; opendir DH, $d or die("Error opening directory: $d\n $!"); my @dirlst = (sort readdir DH) or die("Error reading directory: $d\n $!"); my $od = $d; while ((not $file) and ($od eq $d)) { my $f = $dirlst[$count]; if (($f eq ".") or ($f eq "..") or ($self->{no_dot_files} and $f =~/^\./)) { $count++; next; } if (-d"$d/$f"){ $flter = $f; $flter =~ s/_/ /g; $self->say("$self->{dir_prefix} $flter?"); $answ = $self->getch(); if ($answ =~ /[a-zA-Z0-9]/){ for( my $c = 0; $c < $#dirlst; $c++) { if ($dirlst[$c] =~ /^$answ/) { $count = $c; last; } } next; } if (ord($answ)==27){ $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count == scalar(@dirlst); $count = scalar(@dirlst) - 1 if $count < 0; if (($answ =~/C/) && ($self->{browsable})) { $d = "$d/$f"; last; } if (($answ =~/D/) && ($self->{browsable})) { @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; next; } } }elsif ((ord($answ)==10) or (ord($answ)==13) or (ord($answ)==89) or (ord($answ)==121)){ $file = "$d/$f"; return $file; }elsif ((ord($answ)==85) or (ord($answ)==117)){ @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; next; } }elsif (-f "$d/$f"){ $flter = $f; if ($self->{hide_extentions}){ $flter =~ s/\.[\w]*$//; } if ($self->{make_readable}) { my $pattern = $self->{make_readable}; $flter =~ s/$pattern/ /g; } $self->say("$self->{file_prefix} $flter?"); $answ = $self->getch(); if ($answ =~ /[a-zA-Z0-9]/){ for( my $c = 0; $c < $#dirlst; $c++) { if ($dirlst[$c] =~ /^$answ/) { $count = $c; last; } } next; } if (ord($answ)==27){ $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count == scalar(@dirlst); $count = scalar(@dirlst) - 1 if $count < 0; if (($answ =~/C/) && ($self->{browsable})) { $file = "$d/$f"; last; } if (($answ =~/D/) && ($self->{browsable})) { @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; next; } } }elsif ((ord($answ)==10) or (ord($answ)==89) or (ord($answ)==121)){ $file = "$d/$f"; return $file; last; } }else{print "Error $d/$f";} } closedir DH; } return $file; } sub dirpicker { my $self = shift; my $d = shift; my $folder = ""; my $answ = ""; my @lst = (); while ($folder eq "") { my $count = 0; opendir DH, $d or die("Error opening directory: $d\n $!"); my @dirlst = (sort readdir DH) or die("Error reading directory: $d\n $!"); closedir DH; while ($folder eq "") { my $f = $dirlst[$count]; if (($f eq ".") or ($f eq "..") or ($self->{no_dot_files} and $f =~/^\./)) { $count++; next; } if (-d"$d/$f"){ $self->say($f); $answ = $self->getch(); if (ord($answ)==27){ $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count == scalar(@dirlst); $count = scalar(@dirlst) - 1 if $count < 0; if ($answ =~/C/){ $folder = $self->dirpicker("$d/$f"); } if ($answ =~/D/){ @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; last; } } }elsif ((ord($answ)==10) or (ord($answ)==89) or (ord($answ)==121)){ $folder = "$d/$f"; }elsif ((ord($answ)==85) or (ord($answ)==117)){ @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; last; } }else{ $count++; if ($count > $#dirlst) { $self->say("There are no folders in this directory. Moving up one level."); @lst = split '/', $d; pop @lst; $d = join '/', @lst; $d = '/' if $d eq ""; last; } next; } } } return $folder; } sub fileselect { my $self = shift; my $dir = shift; my @prompt = @_; $prompt[0] = "Enter a file filter" unless $prompt[0]; $prompt[1] = "Press F1 for help" unless $prompt[1]; $prompt[2] = "Spacebar Selects or Deselects a file... Press Control-A to select all... Press enter key when done... Press F1 for help" unless $prompt[2]; chdir $dir; my $filter = $self->getString($prompt[0], 1); my @lst = `ls $filter`; unless ($lst[0]) { $self->say("No Files Found."); return 0; } my @counts; my $count = 0; my $str = ""; my $speech_flag = 1; $self->say($prompt[1]) if $prompt[1]; while (1) { my $fname = ""; chomp $lst[$count]; print "$dir/$lst[$count]\n"; if (-d "$dir/$lst[$count]") { print "DIR\n"; $fname = "$self->{dir_prefix} $lst[$count]"; } elsif (-f "$dir/$lst[$count]") { print "FILE\n"; $fname = "$self->{file_prefix} $lst[$count]"; } $self->say($fname) if $speech_flag; my $answ = $self->getch(); if ($answ eq " ") { # Select or Deselect a file push @counts, $count; $speech_flag = 0; } elsif (ord($answ)==1) { # Control-A @counts = (); my $i; foreach (@lst) { push @counts, $i++; } $speech_flag = 0; } elsif (ord($answ)==27){ $str = ""; $answ = $self->getch(); if (ord($answ)==91){ $answ = $self->getch(); $count++ if $answ =~/B/; $count-- if $answ =~/A/; $count = 0 if $count > $#lst; $count = $#lst if $count < 0; $speech_flag = 1; if (ord($answ)==49){ $a = $self->getch(); $b = $self->getch() if ord($a) == 49; if (ord($b) == 126) { # F1 pressed if ($prompt[2] ne 'F1') { $self->say($prompt[2]); } else { return '^F1 Pressed^'; } } } } } elsif ((ord($answ)==10) or (ord($answ)==13)) { last; } elsif ($answ =~ /\w/) { $str .= lc $answ; $count = 0; foreach (@lst) { my $test = lc $_; if ($test =~ /^$str/) { last; } else { $count++; $count = $#lst if $count > $#lst; } } $speech_flag = 1; } } my %hash; my @file_list; foreach (@counts) { $hash{$_}++; } foreach (keys %hash) { if ($hash{$_} % 2 == 1) { # File is selected push @file_list, $lst[$_]; } } return @file_list; } sub getch { my $self = shift; my $fd_stdin = fileno(STDIN); my $term = POSIX::Termios->new(); $term->getattr($fd_stdin); my $oterm = $term->getlflag(); my $echo = ECHO | ECHOK | ICANON; my $noecho = $oterm & ~$echo; my $key = ''; $term->setlflag($noecho); $term->setcc(VTIME, 1); $term->setattr($fd_stdin, TCSANOW); sysread(STDIN, $key, 1); $term->setlflag($oterm); $term->setcc( VTIME, 0); $term->setattr($fd_stdin, TCSANOW); return $key; } sub getString { my $self = shift; my $prompt = shift; my $no_confirm = shift; $self->say($prompt) if $prompt; my $ord = 0; my $string; my @chrlst; while (1){ my $chr = $self->getch(); $ord = ord($chr); if ($ord == 127) { pop @chrlst; $self->say("Backspace"); } elsif ($ord == 32) { $self->say("Space"); push @chrlst, $chr; } elsif ($ord == 46) { $self->say("dot"); push @chrlst, $chr; } elsif ($ord == 45) { $self->say("dash"); push @chrlst, $chr; } elsif ($ord == 10){ last; } elsif ($ord < 28) { return $ord; } else { $self->say($chr); push @chrlst, $chr; } } $string = join '', @chrlst; chomp $string; if ($no_confirm){ return $string; } else { $self->say("You have entered $string. Is this correct?"); $self->confirm() ? return $string : return $self->getString($prompt); } } sub confirm { my $self = shift; my $txt = shift; $self->say($txt) if $txt; my $answ = $self->getch(); return 1 if $answ =~/[yY\n]/; return 0 if $answ =~/[nN]/; $self->say("Please answer Y for yes or N for no."); return $self->confirm(); } sub getType { my $self = shift; my $fname=shift; my %Type = ( 'HTML', "text/html", 'HTM', "text/html", 'STM', "text/html", 'SHTML', "text/html", 'TXT', "text/plain", 'PREF', "text/plain", 'AIS', "text/plain", 'RTX', "text/richtext", 'TSV', "text/tab-separated-values", 'NFO', "text/warez-info", 'ETX', "text/x-setext", 'SGML', "text/x-sgml", 'SGM', "text/x-sgml", 'TALK', "text/x-speech", 'CGI', "text/plain", # we want these two as text files 'PL', "text/plain", # and not application/x-httpd-cgi 'PHP', "text/plain", #----------------------------------------- 'COD', "image/cis-cod", 'FID', "image/fif", 'GIF', "image/gif", 'ICO', "image/ico", 'IEF', "image/ief", 'JPEG', "image/jpeg", 'JPG', "image/jpeg", 'JPE', "image/jpeg", 'PNG', "image/png", 'TIF', "image/tiff", 'TIFF', "image/tiff", 'MCF', "image/vasa", 'RAS', "image/x-cmu-raster", 'CMX', "image/x-cmx", 'PCD', "image/x-photo-cd", 'PNM', "image/x-portable-anymap", 'PBM', "image/x-portable-bitmap", 'PGM', "image/x-portable-graymap", 'PPM', "image/x-portable-pixmap", 'RGB', "image/x-rgb", 'XBM', "image/x-xbitmap", 'XPM', "image/x-xpixmap", 'XWD', "image/x-xwindowdump", #------------------------------------------ 'BZ2', "application/x-bzip2", 'EXE', "application/octet-stream", 'BIN', "application/octet-stream", 'DMS', "application/octet-stream", 'LHA', "application/octet-stream", 'CLASS', "application/octet-stream", 'DLL', "application/octet-stream", 'AAM', "application/x-authorware-map", 'AAS', "application/x-authorware-seg", 'AAB', "application/x-authorware-bin", 'VMD', "application/vocaltec-media-desc", 'VMF', "application/vocaltec-media-file", 'ASD', "application/astound", 'ASN', "application/astound", 'DWG', "application/autocad", 'DSP', "application/dsptype", 'DFX', "application/dsptype", 'EVY', "application/envoy", 'SPL', "application/futuresplash", 'IMD', "application/immedia", 'HQX', "application/mac-binhex40", 'CPT', "application/mac-compactpro", 'DOC', "application/msword", 'ODA', "application/oda", 'PDF', "application/pdf", 'AI', "application/postscript", 'EPS', "application/postscript", 'PS', "application/postscript", 'PPT', "application/powerpoint", 'RTF', "application/rtf", 'APM', "application/studiom", 'XAR', "application/vnd.xara", 'ANO', "application/x-annotator", 'ASP', "application/x-asap", 'CHAT', "application/x-chat", 'BCPIO', "application/x-bcpio", 'VCD', "application/x-cdlink", 'TGZ', "application/x-compressed", 'Z', "application/x-compress", 'CPIO', "application/x-cpio", 'PUZ', "application/x-crossword", 'CSH', "application/x-csh", 'DCR', "application/x-director", 'DIR', "application/x-director", 'DXR', "application/x-director", 'FGD', "application/x-director", 'DVI', "application/x-dvi", 'LIC', "application/x-enterlicense", 'EPB', "application/x-epublisher", 'FAXMGR', "application/x-fax-manager", 'FAXMGRJOB', "application/x-fax-manager-job", 'FM', "application/x-framemaker", 'FRAME', "application/x-framemaker", 'FRM', "application/x-framemaker", 'MAKER', "application/x-framemaker", 'GTAR', "application/x-gtar", 'GZ', "application/x-gzip", 'HDF', "application/x-hdf", 'INS', "application/x-insight", 'INSIGHT', "application/x-insight", 'INST', "application/x-install", 'IV', "application/x-inventor", 'JS', "application/x-javascript", 'SKP', "application/x-koan", 'SKD', "application/x-koan", 'SKT', "application/x-koan", 'SKM', "application/x-koan", 'LATEX', "application/x-latex", 'LICMGR', "application/x-licensemgr", 'MAIL', "application/x-mailfolder", 'MIF', "application/x-mailfolder", 'NC', "application/x-netcdf", 'CDF', "application/x-netcdf", 'SDS', "application/x-onlive", 'SGI-LPR', "application/x-sgi-lpr", 'SH', "application/x-sh", 'SHAR', "application/x-shar", 'SWF', "application/x-shockwave-flash", 'SPRITE', "application/x-sprite", 'SPR', "application/x-sprite", 'SIT', "application/x-stuffit", 'SV4CPIO', "application/x-sv4cpio", 'SV4CRC', "application/x-sv4crc", 'TAR', "application/x-tar", 'TARDIST', "application/x-tardist", 'TCL', "application/x-tcl", 'TEX', "application/x-tex", 'TEXINFO', "application/x-texinfo", 'TEXI', "application/x-texinfo", 'T', "application/x-troff", 'TR', "application/x-troff", 'TROFF', "application/x-troff", 'MAN', "application/x-troff-man", 'ME', "application/x-troff-me", 'MS', "application/x-troff-ms", 'TVM', "application/x-tvml", 'TVM', "application/x-tvml", 'USTAR', "application/x-ustar", 'SRC', "application/x-wais-source", 'WKZ', "application/x-wingz", 'ZIP', "application/x-zip-compressed", 'ZTARDIST', "application/x-ztardist", #-------------------------------------