code.delx.au - gnu-emacs-elpa/blob - chess-announce.el

   1 ;;; chess-announce.el --- Scheme to verbally announce chess moves
   2
   3 ;; Copyright (C) 2002, 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'chess-game)
  25 (require 'chess-message)
  26
  27 (chess-message-catalog 'english
  28   '((queen        . "queen")
  29     (king         . "king")
  30     (bishop       . "bishop")
  31     (knight       . "knight")
  32     (rook         . "rook")
  33     (pawn         . "pawn")
  34     (short-castle . "short castle")
  35     (long-castle  . "long castle")
  36     (check        . "check")
  37     (checkmate    . "checkmate")
  38     (stalemate    . "stalemate")
  39     (en-passant   . "on possont")
  40     (promote      . "promote to %s")
  41     (piece-moves  . "%s to %s")
  42     (piece-takes  . "%s takes %s at %s")))
  43
  44 (defvar chess-announce-names
  45   '((?q . queen)
  46     (?k . king)
  47     (?b . bishop)
  48     (?n . knight)
  49     (?r . rook)
  50     (?p . pawn)))
  51
  52 (autoload 'festival-start-process "festival")
  53 (autoload 'festival-kill-process "festival")
  54
  55 (defvar chess-announce-functions
  56   (if (and (executable-find "festival")
  57            (not (featurep 'emacspeak)))
  58       (if (fboundp 'festival-say-string)
  59           '(festival-start-process festival-say-string festival-kill-process)
  60         '(ignore chess-announce-festival ignore))
  61     '(ignore message ignore))
  62   "These three functions are used to for announcing moves.
  63 The first is called one start of the announcer.  The second is called
  64 with the string to announce each time.  The third is called to
  65 shutdown the announcer process, if necessary.")
  66
  67 (defsubst chess-piece-name (char)
  68   (chess-string (cdr (assq (downcase char)
  69                            chess-announce-names))))
  70
  71 (defun chess-announce-handler (game event &rest args)
  72   (cond
  73    ((eq event 'initialize)
  74     (funcall (nth 0 chess-announce-functions))
  75     t)
  76
  77    ((eq event 'destroy)
  78     (funcall (nth 2 chess-announce-functions)))
  79
  80    ((eq event 'move)
  81     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
  82            (pos (chess-ply-pos ply)))
  83       (unless (eq (chess-game-data game 'my-color)
  84                   (chess-pos-side-to-move pos))
  85         (let* ((source (chess-ply-source ply))
  86                (target (chess-ply-target ply))
  87                (s-piece (and source (chess-pos-piece pos source)))
  88                (t-piece (and target (chess-pos-piece pos target)))
  89                (which (chess-ply-keyword ply :which))
  90                text)
  91           (if which
  92               (setq which (char-to-string which)))
  93           (cond
  94            ((chess-ply-keyword ply :castle)
  95             (setq text (chess-string 'short-castle)))
  96            ((chess-ply-keyword ply :long-castle)
  97             (setq text (chess-string 'long-castle)))
  98            ((and s-piece t-piece (= t-piece ? ) target)
  99             (setq text
 100                   (concat which
 101                           (chess-string 'piece-moves
 102                                         (chess-piece-name s-piece)
 103                                         (chess-index-to-coord target)))))
 104            ((and s-piece t-piece target)
 105             (setq text
 106                   (concat which
 107                           (chess-string 'piece-takes
 108                                         (chess-piece-name s-piece)
 109                                         (chess-piece-name t-piece)
 110                                         (chess-index-to-coord target))))))
 111
 112           (let ((promotion (chess-ply-keyword ply :promote)))
 113             (if promotion
 114                 (setq text
 115                       (concat text ", "
 116                               (chess-string 'promote
 117                                             (chess-piece-name promotion))))))
 118           (if (chess-ply-keyword ply :en-passant)
 119               (setq text (concat text ", " (chess-string 'en-passant))))
 120           (if (chess-ply-keyword ply :check)
 121               (setq text (concat text ", " (chess-string 'check))))
 122           (if (chess-ply-keyword ply :checkmate)
 123               (setq text (concat text ", " (chess-string 'checkmate))))
 124           (if (chess-ply-keyword ply :stalemate)
 125               (setq text (concat text ", " (chess-string 'stalemate))))
 126
 127           (funcall (nth 1 chess-announce-functions) text)))))
 128    ((eq event 'kibitz)
 129     (funcall (nth 1 chess-announce-functions) (car args)))))
 130
 131 (defun chess-announce-festival (text)
 132   "Announce the given text using festival.
 133 This is less efficient than festival.el, which should be installed if
 134 possible.  Debian installs it automatically when you apt-get install
 135 festival."
 136   (let ((proc (start-process "announce" nil "/usr/bin/festival" "--tts")))
 137     (when (and proc (eq (process-status proc) 'run))
 138       (process-send-string proc (concat text "\n"))
 139       (process-send-eof proc))))
 140
 141 (provide 'chess-announce)
 142
 143 ;;; chess-announce.el ends here