git.gag.com Git - debian/freetts/blob - tools/ArcticToFreeTTS/scheme/dump_int_tone_cart.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 intonation tone cart to stdout.
  11 ;
  12 ; Expects int_tone_cart_tree to be defined.
  13 ;
  14 (define (dump_int_tone_cart)
  15   (set! current_node 0)
  16   (set! nodes (print_cart_nodes int_tone_cart_tree))
  17   (format t "TOTAL %d\n" current_node)
  18   (format t "%s" nodes))
  19
  20 (defvar cart_operators
  21   '(("is" "=")
  22     ("in" "IN")
  23     ("<" "<")
  24     (">" ">")
  25     ("matches" "REGEX")
  26     ("=" "EQUALS"))) ; CST_CART_OP_EQUALS not handled in
  27                      ;    Flite->FreeTTS Conversion
  28                      ; May cause problems.
  29
  30 (define (print_cart_list l)
  31     (cond
  32         ((null? l))
  33         ((cdr l) (format t "%f,%s" (car l) (print_cart_list (cdr l))))
  34         (t (format t "%f" (car l)))))
  35
  36 (define (print_cart_nodes tree)
  37   (set! current_node (+ 1 current_node))
  38   (cond
  39    ((cdr tree) ;node (non-leaf)
  40     (let ((operator (cadr (assoc_string (cadr (car tree)) cart_operators)))
  41           (val (nth 2 (car tree))))
  42       (let ((type (cond
  43                    ((string-equal operator "=") (format t "String(%s)" val))
  44                    ((string-equal operator "REGEX") (format t "Integer(%d)" val))
  45                    ((number? val) (format t "Float(%f)" val))
  46                    ((consp val) (format stderr "List vals not supported here yet\n")
  47                     (error val))
  48                    (t (format t "String(%s)" val))
  49                    )))
  50         (let ((left_val (print_cart_nodes (car (cdr tree)))))
  51           (let ((this_node_val (format t "NODE %s %s %s %d\n"
  52                                        (caar tree) ;feat
  53                                        operator
  54                                        type
  55                                        current_node)))
  56             (let ((right_val (print_cart_nodes (car (cdr (cdr tree))))))
  57               (string-append this_node_val left_val right_val))))
  58         )))
  59    (t (cond
  60        ((cdr tree)
  61         (format t "here\n");
  62         (format t "LEAF String(%s)\n" (caar (cdr (car tree)))))
  63        (t
  64         (format t "here2\n");
  65         (format t "LEAF String(%s)\n" (car (cdr (car tree)))))))))