git.gag.com Git - debian/freetts/blob - tools/ArcticToFreeTTS/scheme/dump_lex.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 given compiled lexicon file to stdout.
  11 ;
  12 (define (dump_lex compiled_lex)
  13      (let ((ifd (fopen compiled_lex "r")))
  14        (if (not (string-equal "MNCL" (readfp ifd)))
  15            (error "dump_lex: input file is not a compiled lexicon\n"))
  16        (while (not (equal? (set! entry (readfp ifd)) (eof-val)))
  17               ;; Determine part of speech character.
  18               ;;
  19               (if (not (car (cdr entry)))
  20                   (set! pos "0")
  21                   (set! pos (substring
  22                              (string-append (car (cdr entry))) 0 1)))
  23               (format t "%s%s\t"  (car entry) pos)
  24
  25               ;; Dump the phones
  26               ;;
  27               (let ((syllables (caddr entry)))
  28                 (while syllables
  29                        (let ((syllable (car syllables)))
  30                          (let ((phones (car syllable)))
  31                            (while phones
  32                                   (if (and (is_a_vowel (car phones))
  33                                            (equal? 1 (car (cdr syllable))))
  34                                       (format t "%s1 " (car phones))
  35                                       (format t "%s " (car phones)))
  36                                   (set! phones (cdr phones)))))
  37                 (set! syllables (cdr syllables))))
  38
  39               (format t "\n"))
  40        (fclose ifd)))
  41
  42 ;; Should be a better way to do this
  43 (set! vowels
  44       '(
  45         ;; radio (CMULEX)
  46         aa ae ah ao aw ax axr ay eh el em en er ey ih iy ow oy uh uw
  47         ;; mrpa (OALD)
  48         uh e a o i u ii uu oo aa @@ ai ei oi au ou e@ i@ u@ @
  49         ;; ogi_worldbet
  50         i: I E @ u U ^ & > A 3r ei aI >i iU aU oU
  51         ))
  52
  53 (define (is_a_vowel p)
  54   (member_string p vowels))