#!/usr/bin/perl -w
# EmacSpeaks Festival
#
# A Emacspeak speech server for Festival written in Perl.

# Initial ideas were taken from espeakf.pl by Mario Lang <mlang@delysid.org>
# but I (Nicholas Volk) have developed and changed the code a lot during
# the process..


# TODO:
# more speed
#  sometimes we are far to slow, since next to all the stuff is being
# synthetized
#  an alternative would be to spy the size of the stack with
#  (audio_mode 'query), but now we would have to listen what festival
#  says. Mario Lang's espeakf.pl had two prosesses, the other one being
#  reserved for the output...
# even more speed
#  shift to monotone (no intonation, little calculation),
#  synthetize small segemnts ... less delay and so on...

# UTF-8 / iso-8859-compliance will be likely to cause (un-)interesting
# problems with äs and ös. grate!



# Copyright (c) Mario Lang xxxx
# Copyright (c) University of Helsinki 2002, 2003

# The UH code was written by Nicholas Volk

use strict;
use IO::Socket;

my $line = 0;
my $logfile = "/tmp/festival.log";

#######################################
# Open logfile for writing
# This is very important for debugging.. 
open(LOG, ">$logfile") or die "Cant open logfile\n";
`chmod a+rw $logfile`; # change this to perl :)

print LOG "Log started at " . `date`;

# create a tcp connection to the festival server
my $handle = connect_to_festival();
print STDERR "Festivities started...\n";
# Set festival to async mode. Probably not necessary. Comments?
send_to_festival("(audio_mode 'async)");
#send_to_festival("(load \"/usr/share/festival/voices/finnish/hy_fi_mv_diphone/festvox/hy_fi_mv_diphone.scm\")");
#send_to_festival("(hy_fi_mv_diphone)");
 

print LOG "INIT: Starting loop.\n";

# local $SIG{PIPE} = \&connect_to_festival;

my $err = 0;

my $queue = "";
my $forkue = "";

my $header = 1;

my $forkint = 0;
send_to_festival("(set! forkint $forkint)");


my $forked_process = 0;
# my $serving = 0;
while ( <STDIN> ) {
    chop(); # remove \n
    s/^\s+//;
    s/\s+/ /g;
    s/ $//;
    if ( $_ eq "" ) { next; }
    $line++;
    print LOG "$line: Input: '$_'\n";
    my $command = $_;
    $command =~ s/ .*$//;
    s/^.*? //; # komento pois syötteestä
    
    # d (deline?) no, puhuu kuitenkin...
    if ( $command eq "d" ) {
	if ($queue =~ /\S/ ) {
	    $forkue = $queue;
	    $forkue =~ s/ +/ /g;
	    print LOG "Queue before loop: $forkue\n";
	    
	    # Split the process. Otherwise the program may
	    # loop here for a while and not read
	    # shut-up's from STDIN...
	    if ( $forked_process = fork ) {}
	    elsif ( defined $forked_process ) { 
		while ( $forkue =~ s/^\s*(.*?)\s*(\[.*?\])// ) {

		    my $utterance = $1;
		    my $command = $2;
		    if ( $utterance =~ /\S/ ) {
			$utterance =~ s/\"/ lainausmerkki /g;
			$utterance =~ s/ +/ /;
			if ( $utterance ne "") {
			    send_to_festival("(if (= $forkint forkint) (SayText \"$utterance\"))\n");
			    # the SayTexts are sent with a delay
			    # to keep them from exhausting 
			    # the Festival server
			    sleep 1;
			}
			
		    }
		    # ... and not the other commands
		    # set voice to mv
		    if ( $command =~ /^\[:np/ ) {
			send_to_festival("(if (not (string-equal current-voice \"hy_fi_mv_diphone\")) (hy_fi_mv_diphone))");
		    }
		    else {
			print LOG "$line: Removed synth command: $command\n";
		    }		    
		}
		if ( $forkue =~ /\S/ ) {
		    send_to_festival("(if (= $forkint forkint) (SayText \"$forkue\"))\n");
		}
		# $serving = 0;
		$forked_process = 0;
		exit; # end the forked process
	    }
	}
	$queue = "";
	next;
    } 
    
    # exit
    if ( $command eq "exit" ) { last; };


    # l (letter?)
    if ( $command eq "l" ) {
	/^\{(.*?)\}/;
	$header = 0;
	$forkint++;
	send_to_festival("(audio_mode 'shup_up)");
	# send_to_festival("(set! forkint $forkint))");
	send_to_festival("(SayText \"$1\")");
	next;
    }
    

    # q (queue)
    if ( $command eq "q" ) {
	if ( /^\{\s*(.*?)\s*\}/ ) {
	    if ( $1 ) {
		$queue .= " $1";
		print LOG "\textracted '$1'\n";
	    }
	} 
	elsif ( /^\{\s*(.*)\s*$/ ) {
	    if ( $1 ) {
		$queue .= " $1";
#		print LOG "queue initial value: '$queue'\n";
	    }
	    $/ = "}";
	    my $tail = <STDIN>;
#	    print LOG "$tail\n";
	    $tail =~ s/\s+/ /g;
	    $/ = "\n";
	    $tail =~ /\s*(.*?)\s*\}$/;
	    if ( $1 ) { $queue .= " $1"; }
	    print LOG "multiline: $queue'\n";
	}
	else { die; }
	next;
    }
    # s (shut up)
    if ( $command eq "s" ) {
	$forkint++;
	send_to_festival("(set! forkint $forkint)");
	send_to_festival("(audio_mode 'shutup)"); 
	next;
    } 

    # t (talk)
    if ( $command eq "t" ) { # tones, unused..
	$forkint++;
	send_to_festival("(set! forkint $forkint)");
	send_to_festival("(SayText \"$queue\")\n");
	$queue = "";
	$forkue = "";
	# espeakf had a beep here...
	next;
    }

    if ( $command eq "tts_capitalize" ) {
	# not supported yet
	next;
    }
    

    if ( $command eq "tts_say" ) {
	/\{\s*(.*?)\s*\}/;
	send_to_festival("(set! forkint $forkint)");
	send_to_festival("(SayText \"$1\")");
	next;
    }
    # DTK:n punctuation mode ei ole tuettu toistaiseksi...
    if ( $command =~ /^tts_set_punctuations/ ) {
	# send_to_festival("(SayText \"panktsueishön moud, tuki puuttuu\")");
	next;
    }

    # nopeuden asettaminen
    # asteikko ei noudata orjallisesti
    # dectalkin asteikkoa
    if ( $command eq "tts_set_speech_rate" ) {
	if ( $_ <= 100 ) { # fastest... 1
	    send_to_festival("(Param.set 'Duration_Stretch 0.4)");
	}
	elsif ( $_ <= 150 ) { # 2.
	    send_to_festival("(Param.set 'Duration_Stretch 0.5)");
	}
	elsif ( $_ <= 200 ) { # 3.
	    send_to_festival("(Param.set 'Duration_Stretch 0.6)");
	}
	elsif ( $_ <= 250 ) { # 4
	    send_to_festival("(Param.set 'Duration_Stretch 0.7)");
	}
	elsif ( $_ <= 300 ) { # 5
	    send_to_festival("(Param.set 'Duration_Stretch 0.8)");
	}
	elsif ( $_ <= 350 ) { # 6
	    send_to_festival("(Param.set 'Duration_Stretch 1.0)");
	}
	elsif ( $_ <= 400 ) { # 7
	    send_to_festival("(Param.set 'Duration_Stretch 1.2)");
	}
	elsif ( $_ <= 450 ) { # 8
	    send_to_festival("(Param.set 'Duration_Stretch 1.5)");
	}
	else { # 9
	    send_to_festival("(Param.set 'Duration_Stretch 2.0)");
	}
	next;
    }
	



    $err++;
    print LOG "$line: err$err: \"$command\"\n";

}
close(LOG);


exit 0;


# ALWAYS send only one command at a time
sub send_to_festival {
    my $command = $_[0];
    if ( $handle ) {   # Sanity checks are always nice...
	if ( ! $header ) {
	    print LOG "$line: festival> $command\n"; 
	    print ($handle "(print $forkint)\n"); 
	    print ($handle $command) or die "Couldn't write to Festival ($!)\n";
	}
    }
    else { 
	$handle = connect_to_festival(); 
	send_to_festival($_[0]);
    }
}


sub connect_to_festival {
    my $handle;
    my $tries = 0;
    while ( !$handle ) {
	print LOG "($tries) Attempting to connect to the Festival server.\n";
	if ( $handle = IO::Socket::INET->new(Proto     => "tcp",
					     PeerAddr => "localhost",
					     # PeerAddr  => "localhost.localdomain",
					     PeerPort  => 1314)) {
	    print LOG "Successfully opened connection to Festival.\n";

	} 
	else {
	    if ($tries) {
		print LOG "Waiting for Festival server to load -- Can't connect to port 1314 on localhost yet ($!).\n";
	    } 
	    else {
		print LOG "Failed to connect to Festival server, attempting to load it myself\n:";
		system("/home/n/v/nvolk/bin/festival --server &");
	    }
	    sleep 1;
	}
	$tries++;
    }
	   
    return $handle;
}


#harry "[:nh ]")
#dennis "[:nd]")
#frank "[:nf]")

#betty "[:nb]")
#ursula "[:nu]")
#rita "[:nr]")
#wendy "[:nw]")
#kit "[:nk]")

#;;; Modified voices:
#;;; Modifications for paul:
#paul-bold "[:np  :dv sm 50 ri 30 pr 200 ap 132]")
#paul-italic
#                  "[:np :dv ap 132 hs 99 pr 200 hr 20 sr 32 qu 100]")
#paul-smooth
#                  "[:np  :dv sm 15 ri 65 sr 50 as 100 qu 100]")
#annotation-voice "[:np :dv  sm 30 ri 50  hr 0 sr 0 ]")
#indent-voice  "[:np :dv  sm 40 ri 40  hr 7  sr 10 ]")
#paul-animated
#                  "[:np  :dv pr 200 hr  30 sr 50 as 100 qu 100]")
#paul-monotone "[:np  :dv pr 0 hr 1 sr 2 as 0 ]")
#;paul-italic "[:np :dv ap 140 hs 99 pr 200  hr 10 sr 20]")   
#paul-angry
#                  "[:np :dv as 90 ap 95 bf 29 hr 13 pr 250 sr 90 br 0 la 0 lx 0 qu 58 ri 100 sm 0 gh 73 gf 74 gv 65]")
#
#(dtk-define-voice
# 'paul-disgusted
# "[:np   :dv as 50 ap 120 bf 18 hr 18 pr 145 sr 26 br 0 la 0 lx 0   qu 0 ri 85 sm 18 gh 74 gf 75 gv 63 b4 261 b5 332 ]")

#(dtk-define-voice
# 'paul-glad
# "[:np   :dv as 39 ap 105 bf 10 hr 5 pr 250 sr 73 br 0 la 0 lx 0   qu 0 ri 56 sm 48 gh 49 gf 67 gv 63 b4 261 b5 332 ]")

#(dtk-define-voice
# 'paul-sad
# "[:np   :dv as 30 ap 120 bf 14 hr 16 pr 50 sr 78 br 72 la 0 lx 100  qu 100 ri 7 sm 94 gh 35 gf 65 gv 62 b4 330 b5 1190 ]")

#paul-scared
#                  "[:np   :dv as 20 ap 300 bf 0 hr 100 pr 250 sr 100 br 0 la 0 lx 0   qu 100 ri 100 sm 0 gh 70 gf 70 gv 65 b4 260 b5 330 ]")

#paul-surprised
#                  "[:np   :dv as 60 ap 120 bf 9 hr 5 pr 220 sr 66 br 0 la 0 lx 0   qu 70 ri 49 sm 54 gh 70 gf 70 gv 64 b4 260 b5 331 ]")

# FROM DTK_TCL.EL
# [dtk-toggle-capitalization
#[dtk-set-rate] [dtk-resume][dtk-pause]
# [dtk-toggle-allcaps-beep]



__END__

=head1 NAME

festival-server - Emacspeak server for the Festival speech synthesizer

=head1 SYNOPSIS

speechd 

=head1 DESCRIPTION

festival-server is a perl script doing Emacspeak server syntax
to festival conversion.
This method makes use of the ogimarkup mode of festival.
=head1 OPTIONS

=head1 FILES

=over 4

=item
/usr/share/emacs/site-lisp/emacspeak/festival-server