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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Scheme to verbally announce moves
   4 ;;
   5
   6 (require 'chess-game)
   7
   8 (chess-message-catalog 'english
   9   '((queen        . "queen")
  10     (king         . "king")
  11     (bishop       . "bishop")
  12     (knight       . "knight")
  13     (rook         . "rook")
  14     (pawn         . "pawn")
  15     (short-castle . "short castle")
  16     (long-castle  . "long castle")
  17     (check        . "check")
  18     (checkmate    . "checkmate")
  19     (stalemate    . "stalemate")
  20     (en-passant   . "on possont")
  21     (promote      . "promote to %s")
  22     (piece-moves  . "%s to %s")
  23     (piece-takes  . "%s takes %s at %s")))
  24
  25 (defvar chess-announce-names
  26   '((?q . queen)
  27     (?k . king)
  28     (?b . bishop)
  29     (?n . knight)
  30     (?r . rook)
  31     (?p . pawn)))
  32
  33 (autoload 'festival-start-process "festival")
  34 (autoload 'festival-kill-process "festival")
  35
  36 (defvar chess-announce-functions
  37   (if (and (executable-find "festival")
  38            (not (featurep 'emacspeak)))
  39       (if (fboundp 'festival-say-string)
  40           '(festival-start-process festival-say-string festival-kill-process)
  41         '(ignore chess-announce-festival ignore))
  42     '(ignore message ignore))
  43   "These three functions are used to for announcing moves.
  44 The first is called one start of the announcer.  The second is called
  45 with the string to announce each time.  The third is called to
  46 shutdown the announcer process, if necessary.")
  47
  48 (defsubst chess-piece-name (char)
  49   (chess-string (cdr (assq (downcase char)
  50                            chess-announce-names))))
  51
  52 (defun chess-announce-handler (game event &rest args)
  53   (cond
  54    ((eq event 'initialize)
  55     (funcall (nth 0 chess-announce-functions))
  56     t)
  57
  58    ((eq event 'destroy)
  59     (funcall (nth 2 chess-announce-functions)))
  60
  61    ((eq event 'move)
  62     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
  63            (pos (chess-ply-pos ply)))
  64       (unless (eq (chess-game-data game 'my-color)
  65                   (chess-pos-side-to-move pos))
  66         (let* ((source (chess-ply-source ply))
  67                (target (chess-ply-target ply))
  68                (s-piece (and source (chess-pos-piece pos source)))
  69                (t-piece (and target (chess-pos-piece pos target)))
  70                (which (chess-ply-keyword ply :which))
  71                text)
  72           (if which
  73               (setq which (char-to-string which)))
  74           (cond
  75            ((chess-ply-keyword ply :castle)
  76             (setq text (chess-string 'short-castle)))
  77            ((chess-ply-keyword ply :long-castle)
  78             (setq text (chess-string 'long-castle)))
  79            ((and s-piece t-piece (= t-piece ? ) target)
  80             (setq text
  81                   (concat which
  82                           (chess-string 'piece-moves
  83                                         (chess-piece-name s-piece)
  84                                         (chess-index-to-coord target)))))
  85            ((and s-piece t-piece target)
  86             (setq text
  87                   (concat which
  88                           (chess-string 'piece-takes
  89                                         (chess-piece-name s-piece)
  90                                         (chess-piece-name t-piece)
  91                                         (chess-index-to-coord target))))))
  92
  93           (let ((promotion (chess-ply-keyword ply :promote)))
  94             (if promotion
  95                 (setq text
  96                       (concat text ", "
  97                               (chess-string 'promote
  98                                             (chess-piece-name promotion))))))
  99           (if (chess-ply-keyword ply :en-passant)
 100               (setq text (concat text ", " (chess-string 'en-passant))))
 101           (if (chess-ply-keyword ply :check)
 102               (setq text (concat text ", " (chess-string 'check))))
 103           (if (chess-ply-keyword ply :checkmate)
 104               (setq text (concat text ", " (chess-string 'checkmate))))
 105           (if (chess-ply-keyword ply :stalemate)
 106               (setq text (concat text ", " (chess-string 'stalemate))))
 107
 108           (funcall (nth 1 chess-announce-functions) text)))))
 109    ((eq event 'kibitz)
 110     (funcall (nth 1 chess-announce-functions) (car args)))))
 111
 112 (defun chess-announce-festival (text)
 113   "Announce the given text using festival.
 114 This is less efficient than festival.el, which should be installed if
 115 possible.  Debian installs it automatically when you apt-get install
 116 festival."
 117   (let ((proc (start-process "announce" nil "/usr/bin/festival" "--tts")))
 118     (when (and proc (eq (process-status proc) 'run))
 119       (process-send-string proc (concat text "\n"))
 120       (process-send-eof proc))))
 121
 122 (provide 'chess-announce)
 123
 124 ;;; chess-announce.el ends here