#!/usr/bin/perl

##########################################################################;
##                                                                       ##
##                           Cepstral, LLC                               ##
##                      Copyright (c) 2005-2006                          ##
##                        All Rights Reserved.                           ##
##                                                                       ##
## EXCEPT WHERE EXPLICITLY COVERED IN SEPARATE LICENSE, CEPSTRAL, LLC    ##
## AND ITS EMPLOYEES DISCLAIM ALL WARRANTIES WITH REGARD TO THIS         ##
## SOFTWARE,  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND    ##
## FITNESS, IN NO EVENT SHALL CEPSTRAL, LLC NOR ITS EMPLOYEES BE LIABLE  ##
## FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES     ##
## WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN    ##
## AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,           ##
## ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF        ##
## THIS SOFTWARE.                                                        ##
##                                                                       ##
##########################################################################;

## This script creates directories that are useable by Festival
## to call Cepstral Swift TTS voices.   Run with no arguments to
## see the usage.  Works with Cepstral Swift 3.1 and later.

## Thanks to Jouke Visser for contributed changes.

use strict;
my $no_locale = '';
eval 'use 5.7.3';
if ($@) {
    $no_locale++;
} else {
    eval 'use Locale::Language; use Locale::Country';
    if ($@) { $no_locale++ };
}
$| = 1;

my @voice_dirs;
my $output_dir = "cepstral_swift";
my $swift_prog = $ENV{SWIFT} || $ENV{SWIFT_PROG} || "swift";

if (not @ARGV) {
    &usage();
    exit 1;
}

@voice_dirs = @ARGV; # get voice directory paths from command line

if (not -e $output_dir) { # make the output directory if we need to
    if (not mkdir $output_dir, 0755) {
	die "Write permission in the current directory is required.\n";
    }
}

print "Creating Festival stubs for Cepstral voices\n";
if ($no_locale) {
    print "* Locale requires perl 5.7.3 or higher.\n";
    print "* Building without locale information as en-US.\n";
}
print "\n";

my @data = (<DATA>);

my $failed = 0;
for my $vdir (@voice_dirs) { # process each voice directory
    my $voxdefs = "$vdir/settings.txt";

    print "$vdir: ";

    if (not -e $voxdefs) {
	print "skipped, cannot find $voxdefs\n";
	$failed++;
	next;
    }

    if (not open VOXDEFS, $voxdefs) {
	print "skipped, cannot open $voxdefs\n";
	$failed++;
	next;
    }

    my %defs;
    while (my $line = <VOXDEFS>) {
	next unless $line =~ s/^\s*\#define\s+//;

	my ($feat, $val) = split /\s+/, $line, 2;
	next unless defined $val;

	chomp $val;
	$val =~ s/^\"(.*)\"$/$1/;
	$defs{$feat} = $val;
    }

    my $name = $defs{"VOXHUMAN"};
    die "Cannot determine name\n" unless $name;

    my $lcname = lc($name);
    my $gender = $defs{"VOXGENDER"};

    # VOXLANG may not be present in the voice as of 4.0.
    # However, it is harmless if you put it in to define this
    my ($lang, $dialect);
    my ($l, $r) = split(/-/,$defs{"VOXLANG"});

    $l = "en" unless defined $l;
    $r = "us" unless defined $r;

    if ($no_locale) {
	$lang = $l;
	$dialect = $r;
    } else {
	$lang = lc(code2language($l));
	$dialect = lc(code2country($r));
    } 

    my $description = sprintf("This is Cepstral voice %s version %s", 
			      $defs{"VOXHUMAN"}, $defs{"VOXVERSION"});

    if (-e "$output_dir/cepstral_$lcname") {
	print "$name exists, updating...\n";
    } else {
	if (not mkdir "$output_dir/cepstral_$lcname", 0755) {
	    die "cannot make directory \"$output_dir/cepstral_$lcname\": $!\n";
	}
    }

    if (not -e "$output_dir/cepstral_$lcname/festvox") {
	if (not mkdir "$output_dir/cepstral_$lcname/festvox", 0755) {
	    die "can't make $output_dir/$lcname/festvox: $!\n";
	}
    }

    my $outscm = "$output_dir/cepstral_$lcname/festvox/cepstral_$lcname.scm";
    if (not open VOICESCM, ">$outscm") {
	die "can't open $outscm for writing: $!\n";
    }

    for (@data) { 
	my $copy = $_;
	$copy =~ s/\$name/$name/g;
	$copy =~ s/\$lcname/$lcname/eg;
	$copy =~ s/\$swiftprog/$swift_prog/g;
	$copy =~ s/\$vdir/$vdir/g;
	$copy =~ s/\$lang/$lang/g;
	$copy =~ s/\$description/$description/g;
	$copy =~ s/\$gender/$gender/g;
	$copy =~ s/\$dialect/$dialect/g;
	print VOICESCM $copy;
    }
    close VOICESCM;

    print "done.\n";
}

sub usage {
    print <<EOUSAGE;

festivalify-cepstral-voice <cepstral_voice_dir> [<cvd2> ...]

Creates a directory called \"$output_dir\" in the current working
directory for each voice directory named as an argument.

When placed inside Festival\'s voices/ directory allows access to 
Cepstral Swift voices from within festival. Requires write permissions
in the current directory, but the result may be copied to Festival\'s
voice directory.

For example,

    cd /usr/share/festival/voices
    festivalify-cepstral-voice /opt/swift/voices/*

Then, for instance within the Festival command line:

    (voice_cepstral_william)
    (SayText \"Hello\")

EOUSAGE

    exit 1;

}

__DATA__
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                       ;;
;;                           Cepstral, LLC                               ;;
;;                      Copyright (c) 2005-2006                          ;;
;;                        All Rights Reserved.                           ;;
;;                                                                       ;;
;; This software may only be used under licence from Cepstral, LLC.      ;;
;;                                                                       ;;
;; EXCEPT WHERE EXPLICITLY COVERED IN SEPARATE LICENSE, CEPSTRAL, LLC    ;;
;; AND ITS EMPLOYEES DISCLAIM ALL WARRANTIES WITH REGARD TO THIS         ;;
;; SOFTWARE,  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND    ;;
;; FITNESS, IN NO EVENT SHALL CEPSTRAL, LLC NOR ITS EMPLOYEES BE LIABLE  ;;
;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES     ;;
;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN    ;;
;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,           ;;
;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF        ;;
;; THIS SOFTWARE.                                                        ;;
;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar swift_progname "$swiftprog")
(defvar swift_voice_dir "$vdir")

(define (swift::synthesize utt)
  (let ((text nil)
	(filename (make_tmp_filename)))
    (cond
     ((string-equal "Text" (utt.type utt))
      (set! text (utt.feat utt "iform")))
     ((string-equal "Tokens" (utt.type utt))
      (set! text "")
      (set! tok (utt.relation.first utt 'Token))
      (while tok
       (set! text
	     (string-append
	      text
	      (item.feat tok "whitespace")
	      (if (string-equal "0" (item.feat tok "prepunctuation"))
		  ""
		  (item.feat tok "prepunctuation"))
	      (item.feat tok "name")
	      (if (string-equal "0" (item.feat tok "punc"))
		  ""
		  (item.feat tok "punc"))))
       (set! tok (item.next tok))))
     (t
      (error "Can only swift synthesize Text and Token utterances")))

    (set! wpm (/ 170 (Param.get "Duration_Stretch")))

    (system
     (format nil
      "%s -d %s %l -p speech/rate=%f -o %s" swift_progname swift_voice_dir text wpm
      filename))
    (utt.import.wave utt (string-append filename))
    (delete-file filename)
    utt)
)

(define (voice_cepstral_$lcname)
  (voice_reset)

  ;; the following loads kal_diphone in order to prime the system
  ;; then does not use it.  However, it does require kal_diphone to
  ;; be present in order to operate correctly.
  (voice_kal_diphone)

  (Parameter.set 'Synth_Method swift::synthesize)
  (set! swift_voice_name "cepstral_$lcname")

  'cepstral_$lcname)
(proclaim_voice
 'cepstral_$lcname
 '((language $lang)
   (gender $gender)
   (dialect "$dialect")
   (description
    "$description")))

(provide 'cepstral_$lcname)