blob: 5fb83a72abe313ee2570cc38cc1538cf75740fe9 (
plain)
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
67
68
69
70
71
72
73
74
75
76
77
78
79
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Scheme to verbally announce moves
;;
;; $Revision$
(require 'chess-game)
(defvar chess-announce-names
'((?q . "queen")
(?k . "king")
(?b . "bishop")
(?n . "knight")
(?r . "rook")
(?p . "pawn")))
(defvar chess-announce-function 'chess-announce-festival
"The function to call for announcing moves audially.
It is passed the string of English text to announce.")
(defun chess-announce-for-game (game perspective)
"Announce moves in GAME on behalf of PERSPECTIVE.
This means that if PERSPECTIVE is t (for white), only black's moves
will be announced."
(chess-game-add-hook game 'chess-announce-event-handler perspective))
(defun chess-announce-change-perspective (game perspective)
"Change the announce perspective in GAME to PERSPECTIVE."
(let ((cell (assq 'chess-announce-event-handler (chess-game-hooks game))))
(if cell
(setcdr cell perspective))))
(defun chess-announce-event-handler (game perspective event &rest args)
"This display module presents a standard chessboard.
See `chess-display-type' for the different kinds of displays."
(cond
((eq event 'pass)
(chess-announce-change-perspective game (not perspective)))
((memq event '(move game-over))
(let* ((ply (chess-game-ply game (1- (chess-game-index game))))
(pos (chess-ply-pos ply)))
(unless (eq perspective (chess-pos-side-to-move pos))
(let* ((changes (chess-ply-changes ply))
(source (car changes))
(target (cadr changes))
(s-piece (chess-pos-piece pos source))
(t-piece (chess-pos-piece pos target))
text)
(cond
((memq :castle changes)
(setq text "kingside castle"))
((memq :long-castle changes)
(setq text "queenside castle"))
((= t-piece ? )
(setq text (concat (cdr (assq (downcase s-piece)
chess-announce-names))
" to "
(chess-index-to-coord target))))
(t
(setq text (concat (cdr (assq (downcase s-piece)
chess-announce-names))
" takes at "
(chess-index-to-coord target)))))
(if (memq :check changes)
(setq text (concat text ", check")))
(if (memq :checkmate changes)
(setq text (concat text ", checkmate")))
(if (memq :stalemate changes)
(setq text (concat text ", stalemate")))
(funcall chess-announce-function text)))))))
(defun chess-announce-festival (text)
"Announce the given text using festival."
(let ((proc (start-process "announce" nil "/usr/bin/festival" "--tts")))
(when (and proc (eq (process-status proc) 'run))
(process-send-string proc (concat text "\n"))
(process-send-eof proc))))
|
