-
Notifications
You must be signed in to change notification settings - Fork 0
/
talkative.lisp
66 lines (55 loc) · 2.33 KB
/
talkative.lisp
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
(uiop:define-package :talkative
(:use :cl)
(:export #:speak-string #:enable #:*speed*))
(in-package :talkative)
;; TODO: Unreadable object method and integer with *print-base* and *print-radix*.
(defclass talkative-stream (trivial-gray-streams:fundamental-character-output-stream)
((buffer :initform '())
(panicky-p :initform nil :initarg :panicky-p)))
(defmethod trivial-gray-streams:stream-line-column ((stream talkative-stream))
0)
(defvar *speed* 240)
(defun speak-string (string &key panicky-p)
(ignore-errors
(uiop:run-program
`("espeak-ng" "--punct"
"-s" ,(princ-to-string *speed*)
"-v" "en-us"
"-k" "20"
,@(when panicky-p
(list "-p" "70"))
,string))))
(defun speak-buffer (stream)
(speak-string
(coerce (reverse (slot-value stream 'buffer)) 'string)
:panicky-p (slot-value stream 'panicky-p))
(setf (slot-value stream 'buffer) '()))
(defmethod trivial-gray-streams:stream-write-char ((stream talkative-stream) character)
(cond
((eql #\Newline character)
(speak-buffer stream))
(t
(push character (slot-value stream 'buffer)))))
(defmethod trivial-gray-streams:stream-finish-output ((stream talkative-stream))
(speak-buffer stream))
(defmethod trivial-gray-streams:stream-force-output ((stream talkative-stream))
(speak-buffer stream))
(defmethod trivial-gray-streams:stream-clear-input ((stream talkative-stream)))
(defun talkative-in (stream)
(make-echo-stream stream (make-instance 'talkative-stream)))
(defun talkative-out (stream)
(make-broadcast-stream stream (make-instance 'talkative-stream)))
(defun talkative-error (stream)
(make-broadcast-stream stream (make-instance 'talkative-stream :panicky-p t)))
(defvar *talkative-enabled* nil)
(defun enable ()
(setf *talkative-enabled* t
*standard-output* (talkative-out *standard-output*)
*error-output* (talkative-error *error-output*)
*debug-io* (make-two-way-stream (talkative-in *debug-io*)
(talkative-error *debug-io*))
*standard-input* (talkative-in *standard-input*)
*trace-output* (talkative-out *trace-output*)
*query-io* (make-two-way-stream (talkative-in *query-io*)
(talkative-out *query-io*)))
nil)