Gaucheでも日本語を喋らせる(3)

最近のテレビは、朝30分程見ると、夜見て欲しい番組の主演者が出てきて、どうでもいいような事を、べらべら喋ってる。

朝だけかと思うと、昼も出てきて、まだ喋ってる。ひどいのになると、夕方のけだるい時間帯にも（TV局もけだるいようで、ひたすら再放送してる）、その人が昔出てた番組をひたすら、流している。

TVは終わったな。キー局全部だぞ。その点、12CHは、旅行とグルメに徹していて偉いぞ。いつ、見始めて、見終わっても、後悔なんて、ちっとも無いから。

Gaucheで喋らせる、一応完成

;; say japanse (using extarnal application mecab and gsay)
;; -*- coding:  utf-8 -*-
;; Usage: gosh say.scm sjis-text-file

(use gauche.process)
(use gauche.charconv)

(define MECAB                  ;; wakati and yomi mode
  '("mecab" "--eos-format=\n"
            "--unk-format=\\s%m"
	    "--node-format=\\s%pS%f[7]" ))

(define ALPHA '((#\a . "えー") (#\b . "びー") (#\c . "しー")
		(#\d . "でー") (#\e . "いー") (#\f . "えふ")
		(#\g . "じー") (#\h . "えっち") (#\i . "あい")
		(#\j . "じぇい") (#\k . "けー") (#\l . "える")
		(#\m . "えむ") (#\n . "えぬ") (#\o . "おー")
		(#\p . "ぴー") (#\q . "きゅー") (#\r . "あーる")
		(#\s . "えす") (#\t . "てー") (#\u . "ゆー")
		(#\v . "ぶい") (#\w . "だぶる") (#\x . "えくす")
		(#\y . "わい") (#\z . "ぜっと") ))

(define PUNCT '((#\. . "どっと") (#\/ . "すら") (#\? . "はてな")
		(#\: . "ころん") (#\- . "まいなす") (#\+ . "ぷらす")
		(#\> . "さんかくこっか") (#\@ . "あっと") (#\& . "あんど")
		(#\( . "かっこ") (#\) . "こっか") (#\! . "びっくり")
		(#\< . "さんかくかっこ") (#\$ . "だら") (#\% "ぱーせんと")
		(#\~ . "ちるだ") (#\* . "こめ") (#\^ . "はっと")
		))

(define MECABTMP "_mecab.tmp")    ; Quick hack for mecab input

(define (j->k str)
  (with-output-to-file MECABTMP
    (lambda ()
      (display  str)))
;      (display (ces-convert str 'utf-8 'sjis)))) ; for inner debug
  (let1 p (run-process MECAB :input MECABTMP :output :pipe)
	(cdr (string-split
	      (ces-convert (read-line (process-output p) #t) 'sjis)
	      "\\s"))))

(define (say str)
  (let1 for-gsay (ces-convert str 'utf-8 'sjis)
    (sys-putenv "AquesTalk" for-gsay)
    (print for-gsay)                             ; monitor
    (process-output->string `("gsay"))))

(define (csub cl tbl)
  (string-join
   (map (lambda (c)
	  (cond
	   ((assoc (char-downcase c) tbl)  => (lambda (v) (cdr v)))
	   (else "しらないもじよー")))
	cl)
   ","))

(define (conv li)
  (map (lambda (str)
	 (let1 cl (string->list str)
	   (cond
	    ((char-set-contains? #[[:digit:]] (car cl)) #`"<NUMK VAL=,|str|>")
	    ((char-set-contains? #[[:alpha:]] (car cl)) (csub cl ALPHA))
	    ((char-set-contains? #[[:punct:]] (car cl)) (csub cl PUNCT))
	    (else str))))
       li))

(define (speak str)
  (let1 li (j->k str)
	(say (string-join (conv li) ","))))

(define (main args)
  (define (scan-line line p)
    (if (eof-object? line)
       (sys-unlink MECABTMP)
       (begin
         (print line)                      ; monitor
         (speak line)
         (scan-line (read-line p #t) p))))
  (call-with-input-file (cadr args)
    (lambda (p)
      (scan-line (read-line p #t) p))))

使い方

上記が、say.scm とすると

c:\sakae\gsay>gosh say.scm smpl.txt
7月22日(水)に、eclispeがありました。
<NUMK VAL=7>,ツキ,<NUMK VAL=22>,ニチ,かっこ,スイ,こっか,ニ,、,いー,しー,える,あ
い,えす,ぴー,いー,ガ,アリ,マシ,タ,。
次回は、イースター島で、見られます。
ジカイ,ハ,、,イースター,トウ,デ,、,ミ,ラレ,マス,。

２行づつペアになっていて、先の行は、原稿。後の行は、gsay経由で、AquesTalk に渡すデータだ。これぐらいになってると、あの人でも、読めるだろう。喋りも棒読みだし。

この子は、まだひ弱です。変なものを食べさせると、即死してしまいますので、鍛えて頂けたら幸いです。

ちょっとはまった事

最初、PUNCHの定義を、rubyっぽく

(define PUNCT '((:. . "どっと") (:/ . "すら") (:? . "はてな")
		(:: . "ころん") (:- . "まいなす") (:+ . "ぷらす")
		(:' . "くぉーと") (:@ . "あっと") (:& . "あんど")
		(:( . "かっこ") (:) . "こっか") (:! . "びっくり")
		(:# . "いげた") (:$ . "だら") (:% "ぱーせんと")
		(:~ . "ちるだ") (:* . "こめ") (:^ . "はっと")
		))

にしてたんだ。この状態で起動すると

c:\sakae\gsay\old>gosh say.scm ../smpl.txt
gosh: "read-error": Read error at "./say.scm":line 25: dot in wrong context

こんなエラーを喰らってしまう。":'" とか、":(" の部分が、お気にめさないらしい。emacsから見ると、:? は、灰色で表示され、いかにも認識しましたよって風になるんだけど、:( の部分は、普通のテキストの扱い。

早く、手を打つべきでしたね。