git.gag.com Git - debian/freetts/blob - tools/ArcticToFreeTTS/scheme/dump_phoneset.scm

   1 ; Portions Copyright 2004 Sun Microsystems, Inc.
   2 ; Portions Copyright 1999-2003 Language Technologies Institute,
   3 ; Carnegie Mellon University.
   4 ; All Rights Reserved.  Use is subject to license terms.
   5 ;
   6 ; See the file "license.terms" for information on usage and
   7 ; redistribution of this file, and for a DISCLAIMER OF ALL
   8 ; WARRANTIES.
   9
  10 ; Dumps the phoneset to stdout.
  11 ;
  12 ; Expects Phoneset.description to be defined.
  13 ;
  14 (define (dump_phoneset)
  15   (phoneset_to_text (PhoneSet.description nil))
  16 )
  17
  18 (define (dump_phone_line feature_schema phone_line)
  19   (let ((feature_names feature_schema)
  20         (phone_name (car phone_line))
  21         (phone_attributes (cdr phone_line)))
  22     (while feature_names
  23            (let ((feature_name (caar feature_names))
  24                  (phone_attribute (car phone_attributes)))
  25              (format t "%s %s %s\n" phone_name feature_name phone_attribute)
  26              (set! feature_names (cdr feature_names))
  27              (set! phone_attributes (cdr phone_attributes))
  28              ))))
  29
  30 (define (phoneset_to_text phoneset)
  31   (let ((feature_schema (car (cdr (car (cdr  phoneset)))))
  32         (phone_lines    (car (cdr (car (cddr phoneset))))))
  33     (while phone_lines
  34            (dump_phone_line feature_schema (car phone_lines))
  35            (set! phone_lines (cdr phone_lines)))
  36     (format t "silence symbol %s\n" (car (cadr (car (PhoneSet.description '(silences))))))
  37 ))