blob: cae5cb78ab1c0df61e7ea49f09010627f58d2c98 (
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Scheme to verbally announce moves
;;
;; $Revision$
(require 'chess-game)
(chess-message-catalog 'english
'((queen . "queen")
(king . "king")
(bishop . "bishop")
(knight . "knight")
(rook . "rook")
(pawn . "pawn")
(short-castle . "short castle")
(long-castle . "long castle")
(check . "check")
(checkmate . "checkmate")
(stalemate . "stalemate")
(en-passant . "on possont")
(piece-moves . "%s to %s")
(piece-takes . "%s takes %s at %s")))
(chess-message-catalog 'german
'((queen . "Dame")
(king . "König")
(bishop . "Läufer")
(knight . "Springer")
(rook . "Turm")
(pawn . "Bauer")
(short-castle . "Kurze Rochade")
(long-castle . "Lange Rochade")
(check . "Schach")
(checkmate . "Schach matt")
(stalemate . "Patt")
(en-passant . "on possont")
(piece-moves . "%s nach %s")
(piece-takes . "%s schlägt %s auf %s")))
(defvar chess-announce-names
'((?q . queen)
(?k . king)
(?b . bishop)
(?n . knight)
(?r . rook)
(?p . pawn)))
(autoload 'festival-start-process "festival")
(autoload 'festival-kill-process "festival")
(defvar chess-announce-functions
(if (and (executable-find "festival")
(not (featurep 'emacspeak)))
(if (fboundp 'festival-say-string)
'(festival-start-process festival-say-string festival-kill-process)
'(ignore chess-announce-festival ignore))
'(ignore message ignore))
"These three functions are used to for announcing moves.
The first is called one start of the announcer. The second is called
with the string to announce each time. The third is called to
shutdown the announcer process, if necessary.")
(defun chess-announce-handler (game event &rest args)
(cond
((eq event 'initialize)
(funcall (nth 0 chess-announce-functions))
t)
((eq event 'destroy)
(funcall (nth 2 chess-announce-functions)))
((eq event 'move)
(let* ((ply (chess-game-ply game (1- (chess-game-index game))))
(pos (chess-ply-pos ply)))
(unless (eq (chess-game-data game 'my-color)
(chess-pos-side-to-move pos))
(let* ((source (chess-ply-source ply))
(target (chess-ply-target ply))
(s-piece (chess-pos-piece pos source))
(t-piece (chess-pos-piece pos target))
(which (chess-ply-keyword ply :which))
text)
(if which
(setq which (char-to-string which)))
(cond
((chess-ply-keyword ply :castle)
(setq text (chess-string 'short-castle)))
((chess-ply-keyword ply :long-castle)
(setq text (chess-string 'long-castle)))
((= t-piece ? )
(setq text
(concat which
(chess-string 'piece-moves
(chess-string
(cdr (assq (downcase s-piece)
chess-announce-names)))
(chess-index-to-coord target)))))
(t
(setq text
(concat which
(chess-string 'piece-takes
(chess-string
(cdr (assq (downcase s-piece)
chess-announce-names)))
(chess-string
(cdr (assq (downcase t-piece)
chess-announce-names)))
(chess-index-to-coord target))))))
(if (chess-ply-keyword ply :en-passant)
(setq text (concat text ", " (chess-string 'en-passant))))
(if (chess-ply-keyword ply :check)
(setq text (concat text ", " (chess-string 'check))))
(if (chess-ply-keyword ply :checkmate)
(setq text (concat text ", " (chess-string 'checkmate))))
(if (chess-ply-keyword ply :stalemate)
(setq text (concat text ", " (chess-string 'stalemate))))
(funcall (nth 1 chess-announce-functions) text)))))))
(defun chess-announce-festival (text)
"Announce the given text using festival.
This is less efficient than festival.el, which should be installed if
possible. Debian installs it automatically when you apt-get install
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))))
(provide 'chess-announce)
;;; chess-announce.el ends here
|
