summaryrefslogtreecommitdiff
path: root/lib/voices/finnish/hy_fi_mv_diphone/festvox/suopuhe_mode.scm
blob: 1203c39d15fb6fdffc5bf961471b1d3c799a4cb1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                       ;;
;;;          Department of General Linguistics / Suopuhe project          ;;
;;;                      University of Helsinki, FI                       ;;
;;;                  Copyright (c) 2000, 2001, 2002, 2003                 ;;
;;;                        All Rights Reserved.                           ;;
;;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; This program is distributed under Gnu Lesser General Public License (cf. the
; file LICENSE in distribution).
 
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU Lesser General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
 
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Lesser General Public License for more details.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                       ;;
;;; Author(s):                                                            ;;
;;;                                                                       ;;
;;;          Nicholas Volk                                                ;;
;;;  e-mail: nvolk@ling.helsinki.fi                                       ;;
;;; address: Department of General Linguistics                            ;;
;;;          PL 9 (Siltavuorenpenger 20A)                                 ;;
;;;          00014 University of Helsinki                                 ;;
;;;          FINLAND                                                      ;;
;;;                                                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This file contains the suopuhe mode. It's based on the Festival's
;; Sable mode, though certain typical text-to-speech mark-up
;; language tags have been omitted, and some more linguistics stuff
;; has been added. 
;; (I think that for example. F0/speed etc. are properties of the voice,
;; and thus I don't allow any mark-up writer to modify it. 
;; Thus, no Donald Ducks!)
;;
;; WISH LIST:
;;
;; Add male/female-option into SPEAKER-tag
;; Audio plays local files, how about WWW (compare with SABLE)...
;;
;; KNOWN BUGS
;;

;; XML-mode's output directory
(if (not (boundp 'suopuhe_output_file_prefix))
    (set! suopuhe_output_file_prefix "/tmp/")) ;; guess whether this will work on windows. The modes are bad in Windows anyway...

(if (not (boundp 'suopuhe_default_voice))
    (set! suopuhe_default_voice 'voice_hy_fi_mv_diphone))

;; the maximum number of sentences to synthetize & save
(if (not (boundp 'suopuhe_max_sentences))
    (set! suopuhe_max_sentences 1000))

;; are the SGML utterances spoken or not?
(if (not (boundp 'suopuhe_aloud))
    (set! suopuhe_aloud t))


(if hy_debug
    (format stderr "Using %s as the output directory!\n" suopuhe_output_file_prefix))


(require_module 'rxp) ;; Richard Tobin's XML parser


(define (list2string list)
  "(list2string LIST)
Construct a string from a list of symbols"
  (let ((str ""))
    (mapcar (lambda (x)
	      (set!  str (string-append str x)))
	    list)
    str))

;; Add Suopuhe-mode to mode-from-suffix list
(set! auto-text-mode-alist
      (cons
       (cons "\\.suo$" 'suopuhe)
       (cons
	(cons "\\.suopuhe$" 'suopuhe)
	auto-text-mode-alist)))


(xml_register_id "-//SUOPUHE//DTD SUOPUHE speech mark up//EN"
		 (cond
;		  (t
;		   "/home/nvolk/public_html/cgi-bin/festival/lib/voices/finnish/festvox/suopuhe.dtd")
		  ((boundp 'hy_fi_mv_dir)
		   (path-append hy_fi_mv_dir "festvox/suopuhe.dtd"))
		  ((boundp 'suo_fi_lj_dir)
		   (path-append suo_fi_lj_dir "festvox/suopuhe.dtd"))
		  (t
		   nil)))

(xml_register_id "-//SABLE//ENTITIES Added Latin 1 for SABLE//EN"
		 (path-append libdir  "sable-latin.ent"))


;; select the filter for suopuhe
(set! suopuhe_filter 
       (cond 
	((boundp 'hy_fi_mv_dir)
	 (string-append hy_fi_mv_dir "festvox/suopuhe_filter.perl"))
	((boundp 'suo_fi_lj_dir)
	 (string-append suo_fi_lj_dir "festvox/suopuhe_filter.perl"))
	(t
	 nil)))

(define (suopuhe_init_globals)
  "(suopuhe_init_globals)
Initialize various global variables."
  (set! suopuhe_language "finnish")
  (set! suopuhe_file_number 1) ;; utts are stored into separate files
  (set! utts nil)
  (set! suopuhe_vol_type 'no_change)
  (set! suopuhe_vol_factor 1.0)
  (set! suopuhe t)
  (set! suopuhe_within_token 0)
  (set! suopuhe_pos_stack nil)
  (set! suopuhe_accent_stack nil)
)


;; TOKENIZATION
(define (suopuhe_token_to_words token name)
  "(suopuhe_token_to_words token name)
SUOPUHE mode token specific analysis."
  (let ((skip (car suopuhe_skip_stack)))
    (format stderr "skip \"%s\"? %s\n" name skip)
    (set! suopuhe_skip_stack (cdr suopuhe_skip_stack))
    (cond
     (skip 
      (format stderr "Removed %s..." name)
      nil)
   ;; skip PUNCtuation
;;   ((string-equal "1" (item.feat token "skip"))
;;    (if (item.prev token) (format t "PUNC-BREAK after %s\n" (item.name (item.prev token))))
;;    nil
;;    )
     
     ;; default: do the standard t2w stuff:
     (t
      (finnish_token_to_words token name)))))
      ;; (original_token_to_words token name)))))





(defvar suopuhe_elements
'(
  ("(suopuhe" (ATTLIST UTT)
   ;(eval (list suopuhe_current_voice))  ;; so we know what state we start in
   (eval (list suopuhe_default_voice))
   (suopuhe_voice_param_setup)
   UTT ;; or nil
   )
  (")suopuhe" (ATTLIST UTT)
   (if (not (null? UTT))
       (begin
	 (xxml_synth UTT)
	 (suopuhe_voice_param_setup)))
   nil
   )
  ("(speaker" (ATTLIST UTT)
   (let ((name (list2string (xxml_attval "name" ATTLIST)))
	 (age (list2string (xxml_attval "age" ATTLIST)))
	 (gender (list2string (xxml_attval "gender" ATTLIST))))
     ;; (print name)
     ;; (print age)
     ;; (print gender)

     ;;; turn the appropriate age/gender/name on
     (cond
      ((and (string-equal name "martti")	    
	    (not (string-equal current-voice "hy_fi_mv_diphone")))
       (hy_fi_mv_diphone))
      ;; we should check whether the voice exits!
      ((and (string-equal name "suo_fi_lj_diphone")
	    ;; not yet on
	    (not (string-equal current-voice "suo_fi_lj_diphone")))
       (suo_fi_lj_diphone))
      ((and (string-equal gender "female")
	    (not (string-equal current-voice "suo_fi_lj_diphone")))
       (suo_fi_lj_diphone))
      ((and (string-equal gender "male")
	    (not (string-equal current-voice "hy_fi_mv_diphone")))
       (hy_fi_mv_diphone))
      ((not (string-equal age "")
	    (format stderr  "The age-parameter is not yet supported!")))
      (t
       nil))
     (set! token_to_words suopuhe_token_to_words)
   UTT))
  (")speaker" (ATTLIST UTT)
   (if (not (null? UTT))
       (begin
	 (xxml_synth UTT)
	 (suopuhe_voice_param_setup)))
   nil
   )
  ;; PAUSE: does not create a file, instead uses unix's sleep command
  ;; to doze off for a while
  ("pause" (ATTLIST UTT)
   (if (not (null? UTT))
       (begin
	 (let ((dur (car (xxml_attval "duration" ATTLIST))))
	   (set! dur (string-append "sleep " dur))
	   ;; since we are not currently creating empty wavs
	   ;; there no point dozing off when we are in the
	   ;; silent mode (suopuhe_aloud is nil)
	   (if (and suopuhe_aloud
		    (string-matches dur "sleep [1-9][0-9]*"))
	       (system dur)))))

	 
   nil)
   

  ("audio" (ATTLIST UTT)
   (if (not (null? UTT))
       (begin
	 (xxml_synth UTT)
	 (suopuhe_voice_param_setup)))  ;; synthesizing anything ready to be synthesized
   (wave.play (wave.load (car (xxml_attval "file" ATTLIST)) "wav"))
   nil)

  ("(utterance" (ATTLIST UTT)
   (if (not (null? UTT))
       (begin
	 (xxml_synth UTT)
	 (suopuhe_voice_param_setup)))
   nil)
 
  (")utterance" (ATTLIST UTT) 
   (if (not (null? UTT))
      (begin
	 (xxml_synth UTT)
	 (suopuhe_voice_param_setup)))
   nil
   )
;;;;;;;;;;;; TOKENS
  ("(token" (ATTLIST UTT)
   (set! suopuhe_within_token 1)
   ;; some variables affecting intonation and stuff...
   (let ((tokpos (list2string (xxml_attval "pos"    ATTLIST)))
	 (tokacc (list2string (xxml_attval "accent" ATTLIST)))
	 (toklis (list2string (xxml_attval "list"   ATTLIST)))
	 )
     (set! xxml_word_features 
	   (cons (list "pos" tokpos) xxml_word_features))
     
     (cond
      ((string-equal tokpos "punc")
       (print "suo4")
       ;; add pause to the end of last word       
       (let ((last_token (utt.relation.last UTT 'Token)))
	 (if (and last_token
		  ;; last_token on tauoton...
		  (string-equal (item.feat last_token "pbreak") "0"))
	     (begin
	       (print "suo2")
	       (item.set_feat last_token "pbreak" "B"))))
       ;; delete the actual string
       (set! suopuhe_skip_stack (append suopuhe_skip_stack (list t))))
      ;; no punc, no (must) pause:
      (t
       (push_pos tokpos)
       (push_accent tokacc)
       (set! suopuhe_skip_stack (append suopuhe_skip_stack (list nil)))
       ;; list intonation
       (if (string-equal toklis "yes")
	   (let ((last_token (utt.relation.last UTT 'Token)))
	     (if last_token
		 (begin
		   (item.set_feat last_token "pbreak" "LB")
		   (if hy_debug
		       (format t "ListBreak after %s\n" (item.name last_token)))))))
       )))
   
   
   UTT)
  
  (")token" (ATTLIST UTT)
   (set! suopuhe_within_token 0)
   UTT)

  ("break" (ATTLIST UTT)
   ;; check that there really is a word after which the pause will be put
   (if (utt.relation.last UTT 'Token)
       (let ((blevel (list2string (xxml_attval "level" ATTLIST)))
	     (last_token (utt.relation.last UTT 'Token)))      
	 
	 ;; some stack manipulation
	 (if (> suopuhe_within_token 0)
	     (begin
	       (push_pos (car suopuhe_pos_stack))
	       (push_accent (car suopuhe_accent_stack))))
	 ;; since PUNC-tags are deleted, 
	 ;; we make this a property of the previous token
	 ;; hope it's a word!
	 (if (string-equal "punc" (item.feat last_token "pos"))
	     (set! last_token (item.prev last_token)))
	 (cond
	  ((string-equal blevel "1")
	   (if last_token
	       (begin
		 (if hy_debug
		     (format t "Adding a B pause after %s.\n" (item.name last_token)))
		 
		 (item.set_feat last_token "pbreak" "B"))))
	  ((string-equal blevel "0")
	   ;; add a no-break marker
	   ;; but do we honour it? can't remember...
	   (if last_token
	       (item.set_feat last_token "pbreak" "NB")))
	  (t
	   (print (string-append "Unexpected value blevel: " blevel))
	   ))))
   UTT)
      
  
  ("phrase" (ATTLIST UTT)
   ;; add a phrase boundary
   ;; marks a phrase command in the dujisaki model
   ;; but does not result in a pause (if I remember correctly)
   (let ((last_token (utt.relation.last UTT 'Token)))
     (if last_token
	 (begin
	   (if hy_debug
	       (format t "Lis�t��n tauko %s-sanan per��n (PB)\n" (item.name last_token)))
	   (item.set_feat last_token "pbreak" "PB"))))

   
   ;; duplicate stack properties
   (if (> suopuhe_within_token 0)
       (begin
	 (push_pos (car suopuhe_pos_stack))
	 ;; (push_ini (car suopuhe_ini_stack))
	 (push_accent (car suopuhe_accent_stack))))

   ;; add a phrase command?
   UTT)


))



(define (suopuhe_init_func)
  "(suopuhe_init_func)
Initialisation for SUOPUHE mode"
  (suopuhe_init_globals)
  (set! original_xxml_elements xxml_elements) ; fixed
  (set! xxml_elements suopuhe_elements)       ; fixed
  (set! original_token_to_words token_to_words) 
  (set! original_english_token_to_words english_token_to_words) ; new
  (set! english_token_to_words suopuhe_token_to_words) 
  (set! token_to_words suopuhe_token_to_words))


(define (suopuhe_exit_func) ; VALMIS
  "(suopuhe_exit_func)
Exit function for SUOPUHE mode"
  (set! xxml_elements original_xxml_elements) ; ok
  (set! token_to_words original_token_to_words) 
  (set! english_token_to_words original_english_token_to_words)
  (set! suopuhe nil))



(define (= x y)
  "(= N1 N2)
Return true if N1 and N2 are equal numbers."
  (and (<= x y) (>= x y)))

(define (suopuhe_voice_param_setup)
  "(suopuhe_voice_param_setup)
Set up original values for various voice parameters."
  (set! suopuhe_pos_stack nil) ;; tieto sanaluokasta/sana
  (set! suopuhe_accent_stack nil) ;; tieto aksentista
  (set! suopuhe_skip_stack nil) ;; t: remove nil: don't
  (set! pos_reversed nil)
  (set! suopuhe_pitch_base_original (cadr (assoc 'target_f0_mean int_lr_params)))
  (set! suopuhe_pitch_med_original (cadr (assoc 'target_f0_mean int_lr_params)))
  (set! suopuhe_pitch_range_original (cadr (assoc 'target_f0_std int_lr_params)))
  (set! suopuhe_rate_speed_original 1.0)

  (if (and after_synth_hooks (not (consp after_synth_hooks)))
      (set! after_synth_hooks 
	    (cons after_synth_hooks (list suopuhe_adjust_volume)))
      (set! after_synth_hooks 
	    (append after_synth_hooks (list suopuhe_adjust_volume)))))

(define (suopuhe_adjust_volume utt)
  "(suopuhe_adjust_volume utt)
Amplify or attenutate signale based on value of suopuhe_vol_factor
and suopuhe_vol_type (absolute or relative)."
  (set! utts (cons utt utts))
  (cond
   ((equal? suopuhe_vol_type 'no_change)
    utt)
   ((equal? suopuhe_vol_type 'absolute)
    (utt.wave.rescale utt suopuhe_vol_factor 'absolute))
   ((equal? suopuhe_vol_type 'relative)
    (utt.wave.rescale utt suopuhe_vol_factor))
   (t
    (format stderr "SUOPUHE: volume unknown type \"%s\"\n" suopuhe_vol_type)
    utt))
   utt)



;;; Declare the new mode to Festival
;;; Keep this at the end of the file!
(set! tts_text_modes
   (cons
    (list
      'suopuhe   ;; mode name
      (list         
       (list 'init_func suopuhe_init_func)
       (list 'exit_func suopuhe_exit_func)
       (list 'filter (format nil "%s" suopuhe_filter)) 
       ;; now we can use suopuhe-mode from anywhere
       '(analysis_type xml)
       ))
    tts_text_modes))

(define (tts file mode)
  "(tts FILE MODE)
  Convert FILE to speech.  MODE identifies any special treatment
  necessary for FILE.  This is simply a front end to tts_file but 
  puts the system in sync audio mode first. [see TTS]"
  (audio_mode 'sync)
  ;; (print (tts_find_text_mode file auto-text-mode-alist))
  (if (and mode 
	   (not (string-equal mode "suopuhe")))
      (tts_file file mode)
      (if (string-equal "suopuhe" 
			(tts_find_text_mode file auto-text-mode-alist))
	  (begin
	    (suopuhe_setup)
	    (tts_file file 'suopuhe))
	  (tts_file file (tts_find_text_mode file auto-text-mode-alist))))
  (audio_mode 'sync) ;; Hmm this is probably bad
  )
;; korvaava versio tts-viritelmiin...
;(define (utt.play utt)
;  "(utt.play UTT)
;Play waveform in utt by current audio method."
;  (print (utt.relationnames utt))
;  (wave.play (utt.wave utt))
;  utt)




(define (push_pos alkio)
  "(push_pos alkio)
Adds alkio to the top of the suopuhe_pos_stack."
  (set! suopuhe_pos_stack
	(cons alkio suopuhe_pos_stack)))

(define (pop_pos)
  "(pop_pos)
Removes and returns the topmost whatever from the suopuhe_pos_stack." 
  (let ((alkio (car suopuhe_pos_stack)))
    (set! suopuhe_pos_stack (cdr suopuhe_pos_stack))
    alkio))

(define (push_accent alkio)
  "(push_accent alkio)
Adds alkio to the top of the suopuhe_accent_stack."
  (set! suopuhe_accent_stack
	(cons alkio suopuhe_accent_stack)))

(define (pop_accent)
  "(pop_accent)
Removes and returns the topmost whatever from the suopuhe_accent_stack."  
  (let ((alkio (car suopuhe_accent_stack)))
    (set! suopuhe_accent_stack (cdr suopuhe_accent_stack))
    alkio))





;; kukin lause talletetaan omaan tiedostoonsa
;; lausenumero on nelilukuinen merkkijono
;; levytilan s��st�miseksi talletetaan vain 100 erinimist� tiedostoa
;; eli 99 ensimm�ist� ja viimeinen...
(define (file_id int)
  (if (> int suopuhe_max_sentences)
      suopuhe_max_sentences
      int))





(define (suopuhe_setup)
  "(suopuhe_setup)
Reset tts hooks for suopuhe mode."
  (set! tts_hooks
	(append 
	 tts_hooks
	 (list save_suopuhe_output)))
  ;; remove (utt.play) from tts_hooks 
  (if (not suopuhe_aloud)
      (set! tts_hooks (remove (car (list utt.play)) tts_hooks)))
  )

(define (save_suopuhe_output utt)
  "(save_suopuhe_output UTT)
Saves the UTT and some textual data about it to files."
  ;; (format stderr "%s" suopuhe_file_number)
  (if (> suopuhe_file_number suopuhe_max_sentences)
      (begin
	(format stderr "Muuttuja suopuhe_file_number ylitt�� muuttujan suopuhe_max_sentences\nasenttaman raja-arvon! Tiedostoa ei talleteta!\n")
	(if (not suopuhe_aloud)
	    (begin
	      (SayText "Muuttuja suopuhe_file_number ylitti muuttujan
suopuhe_max_sentences\nasenttaman raja-arvon")
	      (SayText "Tiedostojen tallennus lopetetaan ja poistutaan ohjelmasta.")
	      (SayText "N�kemiin!")
	      (exit 0)))))
	
  (if (and utt
	   (or suopuhe_aloud
	       (< (+ suopuhe_max_sentences 1) suopuhe_file_number)))
      (begin
	(let ((file (string-append
		     suopuhe_output_file_prefix
		     "suopuhe-"
		     (file_id suopuhe_file_number)
		     ".wav")))
	  (format stderr "suopuhe: saving files into %s!\n" file)
	  (utt.save.wave utt file "wav")
	  (system (string-append "chmod 622 " file)))
	(if hy_debug 
	    (begin
	      (print "SANA===LUOKKA==TAUKO===ALKU===LOPPU===")
	      (print (parts_of_speech utt))))
	;; write phone durations into a file
	(let ((file (string-append
		     suopuhe_output_file_prefix
		     "suopuhe-sanakestot-"
		     (file_id suopuhe_file_number)
		     ".txt"))
	      suopuhe_fp)
	  (set! suopuhe_fp (fopen file "w"))
	  (fwrite
	   (word_durations (utt.relation.first utt 'Word))
	   suopuhe_fp)
	  (fclose suopuhe_fp)
	  (system (string-append "chmod 622 " file)))
	;; <= kirjoitus p��ttyy
	
	(if hy_debug (print "===== SYLLABLE STRESS  ====="))
	(if hy_debug (print (syllable_stress utt)))
	;;(print "==FOONIT (aannekestot.txt)")
	;; kirjoita aannekestot tiedostoon:
	(let ((file (string-append
		     suopuhe_output_file_prefix
		     "suopuhe-aannekestot-"
		     (file_id suopuhe_file_number)
		     ".txt"))
	      suopuhe_fp)
	  (set! suopuhe_fp (fopen file "w"))
	  (fwrite
	   (phone_durations (utt.relation.first utt 'Segment))
	   suopuhe_fp);
	  (fclose suopuhe_fp)
	  (system (string-append "chmod 622 " file)))))
	
	;; <= kirjoitus p��ttyy
	;;(print (aannekestot2 (utt.relation.first utt 'Segment)))
	;; do something more with utt, if you want...
  (set! suopuhe_file_number (+ suopuhe_file_number 1)))
  


(define (word_durations word)
  "(word durations2 WORD)
Returns the name and start and end times of the given word.
Then recursively calls the next word if any and finally
returns a string consisting of data from all words visited."
  (string-append
   (item.feat word "name") "\t"
   ;; (item.feat word "pos") "\t"
   ;; (item.feat word "pbreak") "\t" 
   (item.feat word "word_start") "\t" 
   (item.feat word "word_end") "\n" 
   (if (item.next word)
       (word_durations (item.next word))
       "")))


(define (phone_durations phone)
  "(phone_durations PHONE)
Prints the name and duration of a given PHONE.
The recursively goes through the next phones and does the same for them also."
  (string-append
   ;; (item.features (item.next phone)););)
   (item.feat phone "name") "\t"
   (item.feat phone "end") "\n"
   ;; (item.feat phone "source_end") "\t" ;; dunno what this is...
   ;; (item.feat phone "dur_factor") "\n" ))		
   (if (item.next phone)
       (phone_durations (item.next phone))
       "")))

(define (parts_of_speech utt)
  "(parts_of_speech UTT)
Returns a list of sublists. Each sublist consists of a word's name
and part-of-speech based on the UTTerance."
  (utt.features utt 'Word '(name pos)))

(define (syllable_stress utt)
  "(syllable stress UTT)
Returns a list of sublists. Each sublist consists of a syllable name
and a syllable stress value based on the UTTerance."
  (utt.features utt 'Syllable '(name stress)))


(provide 'suopuhe_mode)