1 /*************************************************************************/
2 /*                                                                       */
3 /*                Centre for Speech Technology Research                  */
4 /*                     University of Edinburgh, UK                       */
5 /*                       Copyright (c) 1996,1997                         */
6 /*                        All Rights Reserved.                           */
7 /*                                                                       */
8 /*  Permission is hereby granted, free of charge, to use and distribute  */
9 /*  this software and its documentation without restriction, including   */
10 /*  without limitation the rights to use, copy, modify, merge, publish,  */
11 /*  distribute, sublicense, and/or sell copies of this work, and to      */
12 /*  permit persons to whom this work is furnished to do so, subject to   */
13 /*  the following conditions:                                            */
14 /*   1. The code must retain the above copyright notice, this list of    */
15 /*      conditions and the following disclaimer.                         */
16 /*   2. Any modifications must be clearly marked as such.                */
17 /*   3. Original authors' names are not deleted.                         */
18 /*   4. The authors' names are not used to endorse or promote products   */
19 /*      derived from this software without specific prior written        */
20 /*      permission.                                                      */
21 /*                                                                       */
22 /*  THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK        */
23 /*  DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING      */
24 /*  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT   */
25 /*  SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE     */
26 /*  FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES    */
27 /*  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN   */
28 /*  AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,          */
29 /*  ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF       */
30 /*  THIS SOFTWARE.                                                       */
31 /*                                                                       */
32 /*************************************************************************/
33 /*                     Author :  Alan W Black                            */
34 /*                     Date   :  April 1996                              */
35 /*-----------------------------------------------------------------------*/
36 /*                                                                       */
37 /*               EST_Utterance access functions (from Lisp)              */
38 /*                                                                       */
39 /*=======================================================================*/
40 #include <cstdio>
41 #include "EST_unix.h"
42 #include "festival.h"
43 #include "festivalP.h"
44 
45 static LISP item_features(LISP sitem, LISP leval = NIL);
46 static LISP item_features(EST_Item *s, bool evaluate_ff=false);
47 static LISP stream_tree_to_lisp(EST_Item *s);
48 
utt_iform(EST_Utterance & utt)49 LISP utt_iform(EST_Utterance &utt)
50 {
51     return read_from_lstring(strintern(utt_iform_string(utt)));
52 }
53 
utt_iform_string(EST_Utterance & utt)54 const EST_String utt_iform_string(EST_Utterance &utt)
55 {
56     return utt.f("iform").string();
57 }
58 
utt_type(EST_Utterance & utt)59 const EST_String utt_type(EST_Utterance &utt)
60 {
61     return utt.f("type").string();
62 }
63 
64 
utt_flat_repr(LISP l_utt)65 static LISP utt_flat_repr( LISP l_utt )
66 {
67   EST_String flat_repr;
68   EST_Utterance *utt = get_c_utt( l_utt );
69 
70   utt_2_flat_repr( *utt, flat_repr );
71 
72   return strcons(flat_repr.length(), flat_repr.str());
73 }
74 
75 
utt_feat(LISP lutt,LISP feat)76 static LISP utt_feat(LISP lutt, LISP feat)
77 {
78     EST_Utterance *u = utterance(lutt);
79     EST_String f = get_c_string(feat);
80     return lisp_val(u->f(f));
81 }
82 
item_utt(LISP i)83 static LISP item_utt(LISP i)
84 {
85     return siod(get_utt(item(i)));
86 }
87 
item_sub_utt(LISP i)88 static LISP item_sub_utt(LISP i)
89 {
90     EST_Utterance *u = new EST_Utterance;
91 
92     sub_utterance(*u,item(i));
93 
94     return siod(u);
95 }
96 
utt_set_feat(LISP u,LISP name,LISP value)97 static LISP utt_set_feat(LISP u, LISP name, LISP value)
98 {
99     EST_String n = get_c_string(name);
100 
101     if (TYPEP(value,tc_flonum))
102 	utterance(u)->f.set(n,get_c_float(value));
103     else if (val_p(value))
104 	utterance(u)->f.set_val(n,val(value));
105     else
106 	utterance(u)->f.set(n,get_c_string(value));
107 
108     return value;
109 }
110 
utt_save(LISP utt,LISP fname,LISP ltype)111 static LISP utt_save(LISP utt, LISP fname, LISP ltype)
112 {
113     EST_Utterance *u = utterance(utt);
114     EST_String filename = get_c_string(fname);
115     if (fname == NIL)
116 	filename = "save.utt";
117     EST_String type = get_c_string(ltype);
118     if (ltype == NIL) type = "est_ascii";
119 
120     if (type == "est_ascii")
121     {
122 	if (u->save(filename,type) != write_ok)
123 	{
124 	    cerr << "utt.save: saving to \"" << filename << "\" failed" <<
125 		endl;
126 	    festival_error();
127 	}
128     }
129     else
130     {
131 	cerr << "utt.save: unknown save format" << endl;
132 	festival_error();
133     }
134 
135     return utt;
136 }
137 
utt_save_relation(LISP utt,LISP rname,LISP fname,LISP evaluate_ff)138 static LISP utt_save_relation(LISP utt, LISP rname, LISP fname,
139 			      LISP evaluate_ff)
140 {
141     // Save relation in named file
142     EST_Utterance *u = utterance(utt);
143     EST_String relname = get_c_string(rname);
144     EST_String filename = get_c_string(fname);
145     bool a;
146 
147     if ((evaluate_ff == NIL) || (get_c_int(evaluate_ff) == 0))
148 	a = false;
149     else
150 	a = true;
151 
152     if (fname == NIL)
153 	filename = "save.utt";
154     EST_Relation *r = u->relation(relname);
155 
156     if (r->save(filename, a) != write_ok)
157     {
158 	cerr << "utt.save.relation: saving to \"" << filename << "\" failed" <<
159 	    endl;
160 	festival_error();
161     }
162     return utt;
163 }
164 
utt_load(LISP utt,LISP fname)165 static LISP utt_load(LISP utt, LISP fname)
166 {
167     EST_Utterance *u;
168     if (utt == NIL)
169 	u = new EST_Utterance;
170     else
171 	u = utterance(utt);
172     EST_String filename = get_c_string(fname);
173 
174     if (u->load(filename) != 0)
175     {
176 	cerr << "utt.load: loading from \"" << filename << "\" failed" <<
177 	    endl;
178 	festival_error();
179     }
180 
181     if (utt == NIL)
182 	return siod(u);
183     else
184 	return utt;
185 }
186 
utt_relation_load(LISP utt,LISP lrelname,LISP lfilename)187 static LISP utt_relation_load(LISP utt, LISP lrelname, LISP lfilename)
188 {
189     EST_Utterance *u;
190     if (utt == NIL)
191 	u = new EST_Utterance;
192     else
193 	u = utterance(utt);
194     EST_String filename = get_c_string(lfilename);
195     EST_String relname = get_c_string(lrelname);
196     EST_Relation *rel = u->create_relation(relname);
197 
198     if (rel->load(filename,"esps") != 0)
199     {
200 	cerr << "utt.load.relation: loading from \"" << filename <<
201 	    "\" failed" << endl;
202 	festival_error();
203     }
204 
205     if (utt == NIL)
206 	return siod(u);
207     else
208 	return utt;
209 }
210 
utt_evaluate_features(LISP utt)211 static LISP utt_evaluate_features(LISP utt)
212 {
213     EST_Utterance *u = utterance(utt);
214     u->evaluate_all_features();
215     return NIL;
216 }
217 
utt_evaluate_relation(LISP utt,LISP rname)218 static LISP utt_evaluate_relation(LISP utt, LISP rname)
219 {
220     EST_Utterance *u = utterance(utt);
221     EST_String relname = get_c_string(rname);
222     EST_Relation *r = u->relation(relname);
223 
224     r->evaluate_item_features();
225     return NIL;
226 }
227 
utt_copy_relation(LISP utt,LISP l_old_name,LISP l_new_name)228 static LISP utt_copy_relation(LISP utt, LISP l_old_name, LISP l_new_name)
229 {
230     EST_Utterance *u = utterance(utt);
231     EST_String old_name = get_c_string(l_old_name);
232     EST_String new_name = get_c_string(l_new_name);
233 
234     u->create_relation(new_name);
235 
236     u->relation(new_name)->f = u->relation(old_name)->f;
237 
238     copy_relation(*u->relation(old_name), *u->relation(new_name));
239 
240     return utt;
241 }
242 
utt_copy_relation_and_items(LISP utt,LISP l_old_name,LISP l_new_name)243 static LISP utt_copy_relation_and_items(LISP utt, LISP l_old_name,
244 					LISP l_new_name)
245 {
246     EST_Utterance *u = utterance(utt);
247     EST_String old_name = get_c_string(l_old_name);
248     EST_String new_name = get_c_string(l_new_name);
249 
250     u->create_relation(new_name);
251 
252     u->relation(new_name)->f = u->relation(old_name)->f;
253 
254     *u->relation(new_name) = *u->relation(old_name);
255 
256     return utt;
257 }
258 
utt_relation_print(LISP utt,LISP l_name)259 static LISP utt_relation_print(LISP utt, LISP l_name)
260 {
261     EST_Utterance *u = utterance(utt);
262     EST_String name = get_c_string(l_name);
263 
264     cout << *u->relation(name);
265     return NIL;
266 }
267 
utt_relation_items(LISP utt,LISP rname)268 static LISP utt_relation_items(LISP utt, LISP rname)
269 {
270     EST_Utterance *u = utterance(utt);
271     EST_String relationname = get_c_string(rname);
272     EST_Item *i;
273     LISP l = NIL;
274 
275     for (i=u->relation(relationname)->head(); i != 0; i=next_item(i))
276 	l = cons(siod(i),l);
277 
278     return reverse(l);
279 }
280 
281 // could be merged with above
282 
utt_relation_tree(LISP utt,LISP sname)283 LISP utt_relation_tree(LISP utt, LISP sname)
284 {
285     EST_Utterance *u = utterance(utt);
286     EST_String relname = get_c_string(sname);
287 
288     return stream_tree_to_lisp(u->relation(relname)->head());
289 }
290 
stream_tree_to_lisp(EST_Item * s)291 static LISP stream_tree_to_lisp(EST_Item *s)
292 {
293     if (s == 0)
294 	return NIL;
295     else
296     {
297 	LISP desc = cons(strintern(s->name()),
298 			 cons(item_features(s, false),NIL));
299 	return cons(cons(desc,stream_tree_to_lisp(s->down())),
300 		    stream_tree_to_lisp(s->next()));
301     }
302 }
303 
set_item_name(LISP litem,LISP newname)304 static LISP set_item_name(LISP litem, LISP newname)
305 {
306     // Set a stream's name to newname
307     EST_Item *s = item(litem);
308 
309     if (s != 0)
310 	s->set_name(get_c_string(newname));
311     return litem;
312 }
313 
utt_relation(LISP utt,LISP relname)314 static LISP utt_relation(LISP utt, LISP relname)
315 {
316     EST_Utterance *u = utterance(utt);
317     EST_String rn = get_c_string(relname);
318     EST_Item *r;
319 
320     r = u->relation(rn)->head();
321 
322     return siod(r);
323 }
324 
utt_relation_create(LISP utt,LISP relname)325 static LISP utt_relation_create(LISP utt, LISP relname)
326 {
327     EST_Utterance *u = utterance(utt);
328     EST_String rn = get_c_string(relname);
329 
330     u->create_relation(rn);
331 
332     return utt;
333 }
334 
utt_relation_delete(LISP utt,LISP relname)335 static LISP utt_relation_delete(LISP utt, LISP relname)
336 {
337     EST_Utterance *u = utterance(utt);
338     EST_String rn = get_c_string(relname);
339 
340     u->remove_relation(rn);
341 
342     return utt;
343 }
344 
utt_relationnames(LISP utt)345 static LISP utt_relationnames(LISP utt)
346 {
347     // Return list of relation names
348     EST_Utterance *u = utterance(utt);
349     LISP relnames = NIL;
350     EST_Features::Entries p;
351 
352     for (p.begin(u->relations); p; p++)
353 	relnames = cons(rintern(p->k),relnames);
354 
355     return reverse(relnames);
356 }
357 
item_relations(LISP si)358 static LISP item_relations(LISP si)
359 {
360     // Return list of relation names
361     EST_Item *s = item(si);
362     LISP relnames = NIL;
363     EST_Litem *p;
364 
365     for (p = s->relations().list.head(); p; p=p->next())
366 	relnames = cons(rintern(s->relations().list(p).k),relnames);
367 
368     return reverse(relnames);
369 }
370 
item_relation_name(LISP si)371 static LISP item_relation_name(LISP si)
372 {
373     // Return list of relation names
374     EST_Item *s = item(si);
375 
376     return rintern(s->relation_name());
377 }
378 
item_relation_remove(LISP li,LISP relname)379 static LISP item_relation_remove(LISP li, LISP relname)
380 {
381     EST_String rn = get_c_string(relname);
382     EST_Item *si = item(li);
383     remove_item(si,rn);
384     // Just in case someone tries to access this again
385     // we set its contents to be 0 which will picked up by item
386     delete (EST_Val *)USERVAL(li);
387     EST_Val vv = est_val((EST_Item *)0);
388     USERVAL(li) = new EST_Val(vv);
389     return NIL;
390 }
391 
utt_relation_append(LISP utt,LISP relname,LISP li)392 static LISP utt_relation_append(LISP utt, LISP relname, LISP li)
393 {
394     EST_Utterance *u = utterance(utt);
395     EST_String rn = get_c_string(relname);
396     EST_Relation *r = u->relation(rn);
397     EST_Item *s=0;
398 
399     if (!r)
400 	return NIL;
401     if (item_p(li))
402 	s = item(li);
403 
404     s = r->append(s);
405 
406     if (consp(li))
407     {
408 	s->set_name(get_c_string(car(li)));
409 	add_item_features(s,car(cdr(li)));
410     }
411 
412     return siod(s);
413 }
414 
item_next(LISP li)415 static LISP item_next(LISP li)
416 {
417     return (li == NIL) ? NIL : siod(item(li)->next());
418 }
419 
item_prev(LISP li)420 static LISP item_prev(LISP li)
421 {
422     return (li == NIL) ? NIL : siod(item(li)->prev());
423 }
424 
item_up(LISP li)425 static LISP item_up(LISP li)
426 {
427     return (li == NIL) ? NIL : siod(item(li)->up());
428 }
429 
item_down(LISP li)430 static LISP item_down(LISP li)
431 {
432     return (li == NIL) ? NIL : siod(item(li)->down());
433 }
434 
item_parent(LISP li)435 static LISP item_parent(LISP li)
436 {
437     if (li == NIL)
438 	return NIL;
439     else
440 	return siod(parent(item(li)));
441 }
442 
item_daughter1(LISP li)443 static LISP item_daughter1(LISP li)
444 {
445     if (li == NIL)
446 	return NIL;
447     else
448 	return siod(daughter1(item(li)));
449 }
450 
item_daughter2(LISP li)451 static LISP item_daughter2(LISP li)
452 {
453     if (li == NIL)
454 	return NIL;
455     else
456 	return siod(daughter2(item(li)));
457 }
458 
item_daughtern(LISP li)459 static LISP item_daughtern(LISP li)
460 {
461     if (li == NIL)
462 	return NIL;
463     else
464 	return siod(daughtern(item(li)));
465 }
466 
item_link1(LISP li)467 static LISP item_link1(LISP li)
468 {
469     if (li == NIL)
470 	return NIL;
471     else
472 	return siod(link1(item(li)));
473 }
474 
item_link2(LISP li)475 static LISP item_link2(LISP li)
476 {
477     if (li == NIL)
478 	return NIL;
479     else
480 	return siod(link2(item(li)));
481 }
482 
item_linkn(LISP li)483 static LISP item_linkn(LISP li)
484 {
485     if (li == NIL)
486 	return NIL;
487     else
488 	return siod(linkn(item(li)));
489 }
490 
item_next_link(LISP li)491 static LISP item_next_link(LISP li)
492 {
493     if (li == NIL)
494 	return NIL;
495     else
496 	return siod(next_link(item(li)));
497 }
498 
item_linkedfrom(LISP li)499 static LISP item_linkedfrom(LISP li)
500 {
501     if (li == NIL)
502 	return NIL;
503     else
504 	return siod(linkedfrom(item(li)));
505 }
506 
item_next_leaf(LISP li)507 static LISP item_next_leaf(LISP li)
508 {
509     return (li == NIL) ? NIL : siod(next_leaf(item(li)));
510 }
511 
item_first_leaf(LISP li)512 static LISP item_first_leaf(LISP li)
513 {
514     return (li == NIL) ? NIL : siod(first_leaf(item(li)));
515 }
516 
item_last_leaf(LISP li)517 static LISP item_last_leaf(LISP li)
518 {
519     return (li == NIL) ? NIL : siod(last_leaf(item(li)));
520 }
521 
item_add_link(LISP lfrom,LISP lto)522 static LISP item_add_link(LISP lfrom, LISP lto)
523 {
524     add_link(item(lfrom),item(lto));
525     return NIL;
526 }
527 
utt_id(LISP lutt,LISP l_id)528 static LISP utt_id(LISP lutt, LISP l_id)
529 {
530     EST_Utterance *u = utterance(lutt);
531 
532     return siod(u->id(get_c_string(l_id)));
533 }
534 
item_next_item(LISP li)535 static LISP item_next_item(LISP li)
536 {
537     return (li == NIL) ? NIL : siod(next_item(item(li)));
538 }
539 
item_append_daughter(LISP li,LISP nli)540 static LISP item_append_daughter(LISP li,LISP nli)
541 {
542     EST_Item *l = item(li);
543     EST_Item *s = 0;
544 
545     if (item_p(nli))
546 	s = item(nli);
547 
548     s = l->append_daughter(s);
549 
550     if (consp(nli))
551     {
552 	s->set_name(get_c_string(car(nli)));
553 	add_item_features(s,car(cdr(nli)));
554     }
555 
556     return siod(s);
557 }
558 
item_prepend_daughter(LISP li,LISP nli)559 static LISP item_prepend_daughter(LISP li,LISP nli)
560 {
561     EST_Item *l = item(li);
562     EST_Item *s = 0;
563 
564     if (item_p(nli))
565 	s = item(nli);
566 
567     s = l->prepend_daughter(s);
568 
569     if (consp(nli))
570     {
571 	s->set_name(get_c_string(car(nli)));
572 	add_item_features(s,car(cdr(nli)));
573     }
574 
575     return siod(s);
576 }
577 
item_insert_parent(LISP li,LISP nparent)578 static LISP item_insert_parent(LISP li,LISP nparent)
579 {
580     EST_Item *l = item(li);
581     EST_Item *s = 0;
582 
583     if (item_p(nparent))
584 	s = item(nparent);
585 
586     s = l->insert_parent(s);
587 
588     if (consp(nparent))
589     {
590 	s->set_name(get_c_string(car(nparent)));
591 	add_item_features(s,car(cdr(nparent)));
592     }
593 
594     return siod(s);
595 }
596 
item_insert(LISP li,LISP nli,LISP direction)597 static LISP item_insert(LISP li,LISP nli,LISP direction)
598 {
599     EST_Item *n = item(li);
600     EST_String dir;
601     EST_Item *s;
602 
603     if (item_p(nli))
604 	s = item(nli);
605     else
606 	s = 0;
607 
608     if (direction)
609 	dir = get_c_string(direction);
610     else
611 	dir = "after";
612 
613     if (dir == "after")
614 	s = n->insert_after(s);
615     else if (dir == "before")
616 	s = n->insert_before(s);
617     else if (dir == "above")
618 	s = n->insert_above(s);
619     else if (dir == "below")
620 	s = n->insert_below(s);
621     else
622     {
623 	cerr << "item.insert: unknown direction \"" << dir << "\"" << endl;
624 	festival_error();
625     }
626 
627     if (consp(nli))  // specified information
628     {
629 	s->set_name(get_c_string(car(nli)));
630 	add_item_features(s,car(cdr(nli)));
631     }
632 
633     return siod(s);
634 }
635 
item_move_tree(LISP from,LISP to)636 static LISP item_move_tree(LISP from,LISP to)
637 {
638     EST_Item *f = item(from);
639     EST_Item *t = item(to);
640 
641     if (move_sub_tree(f,t) == TRUE)
642 	return truth;
643     else
644 	return NIL;
645 }
646 
item_merge_item(LISP from,LISP to)647 static LISP item_merge_item(LISP from,LISP to)
648 {
649     EST_Item *f = item(from);
650     EST_Item *t = item(to);
651 
652     merge_item(f,t);
653     return truth;
654 }
655 
item_exchange_tree(LISP from,LISP to)656 static LISP item_exchange_tree(LISP from,LISP to)
657 {
658     EST_Item *f = item(from);
659     EST_Item *t = item(to);
660 
661     if (exchange_sub_trees(f,t) == TRUE)
662 	return truth;
663     else
664 	return NIL;
665 }
666 
item_relation(LISP lingitem,LISP relname)667 static LISP item_relation(LISP lingitem,LISP relname)
668 {
669     EST_Item *li = item(lingitem);
670     EST_String rn = get_c_string(relname);
671     return siod(li->as_relation(rn));
672 }
673 
utt_cleanup(EST_Utterance & u)674 void utt_cleanup(EST_Utterance &u)
675 {
676     // Remove all relations
677     // This is called in the Initialization to ensure we can
678     // continue with a nice clean utterance
679 
680     u.relations.clear();
681 }
682 
make_utterance(LISP args,LISP env)683 LISP make_utterance(LISP args,LISP env)
684 {
685     /* Make an utterance structure from given input */
686     (void)env;
687     EST_Utterance *u = new EST_Utterance;
688     EST_String t;
689     LISP lform;
690 
691     u->f.set("type",get_c_string(car(args)));
692     lform = car(cdr(args));
693     u->f.set("iform",siod_sprint(lform));
694 
695     return siod(u);
696 }
697 
item_delete(LISP litem)698 static LISP item_delete(LISP litem)
699 {
700     EST_Item *s = item(litem);
701 
702     s->unref_all();
703     delete (EST_Val *)USERVAL(litem);
704     EST_Val vv = est_val((EST_Item *)0);
705     USERVAL(litem) = new EST_Val(vv);
706 
707     return NIL;
708 }
709 
item_remove_feature(LISP litem,LISP fname)710 static LISP item_remove_feature(LISP litem,LISP fname)
711 {
712     EST_Item *s = item(litem);
713     EST_String f = get_c_string(fname);
714 
715     s->f_remove(f);
716 
717     return rintern("t");
718 }
719 
item_features(LISP litem,LISP leval)720 static LISP item_features(LISP litem, LISP leval)
721 {
722     // Return assoc list of features on this stream
723     return item_features(item(litem), ((leval != NIL) ? true : false));
724 }
725 
item_features(EST_Item * s,bool evaluate_ff)726 static LISP item_features(EST_Item *s, bool evaluate_ff)
727 {
728     // Can't simply use features_to_lisp as evaluation requires access
729     // to item.
730     LISP features = NIL;
731     EST_Val tv;
732 
733     EST_Features::Entries p;
734     for (p.begin(s->features()); p != 0; ++p)
735     {
736 	const EST_Val &v = p->v;
737 	LISP fpair;
738 
739 	if (v.type() == val_int)
740 	    fpair = make_param_int(p->k, v.Int());
741 	else if (v.type() == val_float)
742 	    fpair = make_param_float(p->k, v.Float());
743 	else if (v.type() == val_type_feats)
744 	    fpair = make_param_lisp(p->k,
745 				    features_to_lisp(*feats(v)));
746 	else if ((v.type() == val_type_featfunc) && evaluate_ff)
747 	{
748 	    tv = (featfunc(v))(s);
749 	    if (tv.type() == val_int)
750 		fpair = make_param_int(p->k, tv.Int());
751 	    else if (tv.type() == val_float)
752 	    {
753 		fpair = make_param_float(p->k,
754 					 tv.Float());
755 	    }
756 	    else
757 		fpair = make_param_lisp(p->k,
758 					strintern(tv.string()));
759 	}
760 	else
761 	    fpair = make_param_lisp(p->k,
762 				    strintern(v.string()));
763 	features = cons(fpair,features);
764     }
765 
766     return reverse(features);
767 }
768 
add_item_features(EST_Item * s,LISP features)769 void add_item_features(EST_Item *s,LISP features)
770 {
771     // Add LISP specified features to s;
772     LISP f;
773 
774     for (f=features; f != NIL; f=cdr(f))
775 	s->set_val(get_c_string(car(car(f))),
776 		   val_lisp(car(cdr(car(f)))));
777 }
778 
festival_utterance_init(void)779 void festival_utterance_init(void)
780 {
781     // declare utterance specific Lisp functions
782 
783     // Standard functions
784     init_fsubr("Utterance",make_utterance,
785  "(Utterance TYPE DATA)\n\
786   Build an utterance of type TYPE from DATA.  Different TYPEs require\n\
787   different types of data.  New types may be defined by defUttType.\n\
788   [see Utterance types]");
789     init_subr_2("utt.load",utt_load,
790  "(utt.load UTT FILENAME)\n\
791   Loads UTT with the streams and stream items described in FILENAME.\n\
792   The format is Xlabel-like as saved by utt.save.  If UTT is nil a new\n\
793   utterance is created, loaded and returned.  If FILENAME is \"-\"\n\
794   the data is read from stdin.");
795     init_subr_2("utt.feat",utt_feat,
796  "(utt.feat UTT FEATNAME)\n\
797   Return value of feature name in UTT.");
798     init_subr_3("utt.set_feat",utt_set_feat,
799  "(utt.set_feat UTT FEATNAME VALUE)\n\
800   Set feature FEATNAME with VALUE in UTT.");
801     init_subr_1("utt.flat_repr", utt_flat_repr,
802   "(utt.flat_repr UTT)\n\
803    Returns a flat, string representation of the linguistic information\n\
804    contained in fully formed utterance structure UTT." );
805     init_subr_3("utt.relation.load",utt_relation_load,
806  "(utt.relation.load UTT RELATIONNAME FILENAME)\n\
807   Loads (and creates) RELATIONNAME from FILENAME into UTT.  FILENAME\n\
808   should contain simple Xlabel format information.  The label part\n\
809   may contain the label proper followed by semi-colon separated\n\
810   pairs of feature and value.");
811     init_subr_3("utt.save",utt_save,
812  "(utt.save UTT FILENAME TYPE)\n\
813   Save UTT in FILENAME in an Xlabel-like format.  If FILENAME is \"-\"\n\
814   then print output to stdout.  TYPE may be nil or est_ascii");
815     init_subr_4("utt.save.relation",utt_save_relation,
816  "(utt.save UTT RELATIONNAME FILENAME EVALUATE_FEATURES)\n\
817   Save relation RELATIONNAME in FILENAME in an Xlabel-like format. \n\
818   If FILENAME is \"-\" then print output to stdout.");
819 
820     init_subr_3("utt.copy_relation", utt_copy_relation,
821     "(utt.copy_relation UTT FROM TO)\n\
822     copy relation \"from\" to a new relation \"to\". Note that items\n\
823     are NOT copied, simply linked into the new relation");
824 
825      init_subr_3("utt.copy_relation_and_items", utt_copy_relation_and_items,
826    "(utt.copy_relation_and_items UTT FROM TO)\n\
827     copy relation and contents of items \"from\" to a new relation \"to\"");
828 
829     init_subr_2("utt.relation.print", utt_relation_print,
830   "(utt.relation.print UTT NAME)\n\
831    print contents of relation NAME");
832 
833     init_subr_1("utt.evaluate", utt_evaluate_features,
834   "(utt.evaluate UTT)\n\
835    evaluate all the features in UTT, replacing feature functions\n\
836    with their evaluation.");
837 
838     init_subr_2("utt.evaluate.relation", utt_evaluate_relation,
839   "(utt.evaluate.relation UTT)\n\
840    evaluate all the features in RELATION in UTT, replacing feature functions\n\
841    with their evaluation.");
842 
843     init_subr_2("utt.relation.items",utt_relation_items,
844  "(utt.relation.items UTT RELATIONNAME)\n\
845   Return a list of stream items in RELATIONNAME in UTT. \n\
846   If this relation is a tree, the parent streamitem is listed before its \n\
847   daughters.");
848     init_subr_2("utt.relation_tree",utt_relation_tree,
849  "(utt.relation_tree UTT RELATIONNAME)\n\
850   Return a tree of stream items in RELATIONNAME in UTT.  This will give a\n\
851   simple list if the relation has no ups and downs. \n\
852   [see Accessing an utterance]");
853     init_subr_1("item.delete",item_delete,
854  "(item.delete ITEM)\n\
855   Remove this item from all relations it is in and delete it.");
856     init_subr_2("item.set_name",set_item_name,
857  "(item.set_name ITEM NAME)\n\
858   Sets ITEM's name to NAME. [see Accessing an utterance]");
859     init_subr_2("item.features",item_features,
860  "(item.features ITEM EVALUATE_FEATURES))\n\
861   Returns all features in ITEM as an assoc list.");
862     init_subr_2("item.remove_feature",item_remove_feature,
863  "(item.remove_feature ITEM FNAME)\n\
864   Remove feature named FNAME from ITEM.  Returns t is successfully\n\
865   remove, nil if not found.");
866 
867     // New Utterance architecture (Relations and items)
868     init_subr_2("utt.relation",utt_relation,
869  "(utt.relation UTT RELATIONNAME)\n\
870   Return root item of relation RELATIONNAME in UTT.");
871     init_subr_2("utt.relation.create",utt_relation_create,
872  "(utt.relation.create UTT RELATIONNAME)\n\
873   Create new relation called RELATIONNAME in UTT.");
874     init_subr_2("utt.relation.delete",utt_relation_delete,
875  "(utt.relation.delete UTT RELATIONNAME)\n\
876   Delete relation from utt, it the stream items are not linked elsewhere\n\
877   in the utterance they will be deleted too.");
878     init_subr_2("item.relation.remove",item_relation_remove,
879  "(item.relation.remove ITEM RELATIONNAME)\n\
880   Remove this item from Relation, if it apears in no other relation it\n\
881   will be deleted too, in contrast item.delete will remove an item\n\
882   from all other relations, while this just removes it from this relation.\n\
883   Note this will also remove all daughters of this item in this \n\
884   relation from this relation.");
885     init_subr_1("utt.relationnames",utt_relationnames,
886  "(utt.relationnames UTT)\n\
887   List of all relations in this utterance.");
888     init_subr_3("utt.relation.append",utt_relation_append,
889  "(utt.relation.append UTT RELATIONNAME ITEM)\n\
890   Append ITEM to top of RELATIONNAM in UTT.  ITEM may be\n\
891   a LISP description of an item or an item itself.");
892 
893     init_subr_1("item.next",item_next,
894  "(item.next ITEM)\n\
895   Return the next ITEM in the current relation, or nil if there is\n\
896   no next.");
897     init_subr_1("item.prev",item_prev,
898  "(item.prev ITEM)\n\
899   Return the previous ITEM in the current relation, or nil if there\n\
900   is no previous.");
901     init_subr_1("item.up",item_up,
902  "(item.up ITEM)\n\
903   Return the item above ITEM, or nil if there is none.");
904     init_subr_1("item.down",item_down,
905  "(item.down ITEM)\n\
906   Return the item below ITEM, or nil if there is none.");
907     init_subr_3("item.insert",item_insert,
908  "(item.insert ITEM1 ITEM2 DIRECTION)\n\
909   Insert ITEM2 in ITEM1's relation with respect to DIRECTION.  If DIRECTION\n\
910   is unspecified, after, is assumed.  Valid DIRECTIONS as before, after,\n\
911   above and below.  Use the functions item.insert_parent and\n\
912   item.append_daughter for specific tree adjoining.  If ITEM2 is of\n\
913   type item then it is added directly, otherwise it is treated as a\n\
914   description of an item and new one is created.");
915 
916     // Relation tree access/creation functions
917     init_subr_1("item.parent",item_parent,
918  "(item.parent ITEM)\n\
919   Return the item of ITEM, or nil if there is none.");
920     init_subr_1("item.daughter1",item_daughter1,
921  "(item.daughter1 ITEM)\n\
922   Return the first daughter of ITEM, or nil if there is none.");
923     init_subr_1("item.daughter2",item_daughter2,
924  "(item.daughter2 ITEM)\n\
925   Return the second daughter of ITEM, or nil if there is none.");
926     init_subr_1("item.daughtern",item_daughtern,
927  "(item.daughtern ITEM)\n\
928   Return the last daughter of ITEM, or nil if there is none.");
929     init_subr_1("item.next_leaf",item_next_leaf,
930  "(item.next_leaf ITEM)\n\
931   Return the next leaf item (i.e. one with no daughters) in this \n\
932   relation.  Note this may traverse up and down the relation tree \n\
933   significantly to find it.");
934     init_subr_1("item.first_leaf",item_first_leaf,
935  "(item.first_leaf ITEM)\n\
936   Returns he left most leaf in the tree dominated by ITEM.  This \n\
937   is like calling item.daughter1 recursively until an item with no \n\
938   daughters is found.");
939     init_subr_1("item.last_leaf",item_last_leaf,
940  "(item.last_leaf ITEM)\n\
941   Returns he right most leaf in the tree dominated by ITEM.  This \n\
942   is like calling item.daughtern recursively until an item with no \n\
943   daughters is found.");
944     init_subr_2("item.append_daughter",item_append_daughter,
945  "(item.append_daughter ITEM1 ITEM2)\n\
946   Add a ITEM2 a new daughter (right-most) to ITEM1 in the relation of \n\
947   ITEM1. If ITEM2 is of type item then it is added directly otherwise\n\
948   ITEM2 is treated as a description of an item and a one is created\n\
949   with that description (name features).");
950     init_subr_2("item.prepend_daughter",item_prepend_daughter,
951  "(item.prepend_daughter ITEM1 ITEM2)\n\
952   Add a ITEM2 a new daughter (left-most) to ITEM1 in the relation of ITEM1.\n\
953   If ITEM2 is of type item then it is added directly otherwise\n\
954   ITEM2 is treated as a description of an item and a one is created\n\
955   with that description (name features).");
956     init_subr_2("item.insert_parent",item_insert_parent,
957  "(item.insert_parent ITEM1 ITEM2)\n\
958   Insert a new parent between this ITEM1 and its parentm in ITEM1's \n\
959   relation.  If ITEM2 is of type item then it is added directly, \n\
960   otherwise it is treated as a description of an item and  one is created\n\
961   with that description (name features).");
962 
963 
964     // MLS access/creation functions
965     init_subr_1("item.link1",item_link1,
966  "(item.link1 ITEM)\n\
967   Return first item linked to ITEM in current relation.");
968     init_subr_1("item.link2",item_link2,
969  "(item.link2 ITEM)\n\
970   Return second item linked to ITEM in current relation.");
971     init_subr_1("item.linkn",item_linkn,
972  "(item.linkn ITEM)\n\
973   Return last item linked to ITEM in current relation.");
974     init_subr_1("item.next_link",item_next_link,
975  "(item.next_link ITEM)\n\
976   Return next item licked to the same item ITEM is linked to.");
977     init_subr_1("item.linkedfrom",item_linkedfrom,
978  "(item.linkedfrom ITEM)\n\
979   Return the item tht is linked to ITEM.");
980     init_subr_2("item.add_link",item_add_link,
981  "(item.add_link ITEMFROM ITEMTO)\n\
982   Add a link from ITEMFROM to ITEMTO is the relation ITEMFROM is in.");
983 
984     init_subr_1("item.next_item",item_next_item,
985  "(item.next_item ITEM)\n\
986   Will give next item in this relation visiting every item in the \n\
987   relation until the end.  Traverses in pre-order, root followed by \n\
988   daughters (then siblings).");
989 
990     init_subr_2("utt.id", utt_id,
991  "(utt.id UTT id_number)\n\
992   Return the item in UTT whose id matches id_number.");
993 
994     init_subr_2("item.relation",item_relation,
995  "(item.relation ITEM RELATIONNAME)\n\
996   Return the item such whose relation is RELATIONNAME.  If ITEM\n\
997   is not in RELATIONNAME then nil is return.");
998 
999     init_subr_1("item.relations",item_relations,
1000  "(item.relations ITEM)\n\
1001   Return a list of names of the relations this item is in.");
1002     init_subr_1("item.relation.name",item_relation_name,
1003  "(item.relation.name ITEM)\n\
1004   Return the name of the relation this ITEM is currently being viewed\n\
1005   through.");
1006     init_subr_2("item.move_tree",item_move_tree,
1007  "(item.move_tree FROM TO)\n\
1008   Move contents, and descendants of FROM to TO. Old daughters of TO are\n\
1009   deleted.  FROM will be deleted too if it is being viewed as the same\n\
1010   same relation as TO.  FROM will be deleted from its current place in\n\
1011   TO's relation. Returns t if successful, returns nil if TO is within FROM.");
1012     init_subr_2("item.exchange_trees",item_exchange_tree,
1013  "(item.exchange_tree FROM TO)\n\
1014   Exchanged contents of FROM and TO, and descendants of FROM and TO.\n\
1015   Returns t if successful, or nil if FROM or TO contain each other.");
1016     init_subr_2("item.merge",item_merge_item,
1017  "(item.merge FROM TO)\n\
1018   Merge FROM into TO making them the same items.  All features in FROM\n\
1019   are merged into TO and all references to FROM are made to point to TO.");
1020     init_subr_1("item.get_utt",item_utt,
1021   "(item.get_utt ITEM)\n\
1022   Get utterance from given ITEM (if possible).");
1023     init_subr_1("sub_utt",item_sub_utt,
1024   "(sub_utt ITEM)\n\
1025   Return a new utterance that contains a copy of this item and all its\n\
1026   descendants and related descendants.");
1027 
1028     init_subr_1("audio_mode",l_audio_mode,
1029  "(audio_mode MODE)\n\
1030  Control audio specific modes.  Five subcommands are supported. If\n\
1031  MODE is async, start the audio spooler so that Festival need not wait\n\
1032  for a waveform to complete playing before continuing.  If MODE is\n\
1033  sync wait for the audio spooler to empty, if running, and they cause\n\
1034  future plays to wait for the playing to complete before continuing.\n\
1035  Other MODEs are, close which waits for the audio spooler to finish\n\
1036  any waveforms in the queue and then closes the spooler (it will restart\n\
1037  on the next play), shutup, stops the current waveform playing and empties\n\
1038  the queue, and query which lists the files in the queue.  The queue may\n\
1039  be up to five waveforms long. [see Audio output]");
1040 
1041 }
1042