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

   1 ;;; chess-sound.el --- Announce chess moves with pre-recorded sound files
   2
   3 ;; Copyright (C) 2002, 2008, 2014  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 ;;; Commentary:
  23
  24 ;; This is very similar to chess-announce, except it uses specific
  25 ;; .WAV files instead of text-to-speech.
  26
  27 ;;; Code:
  28
  29 (require 'chess-game)
  30
  31 (defgroup chess-sound nil
  32   "Code to play specific sounds when announcing chess moves."
  33   :group 'chess)
  34
  35 (defcustom chess-sound-directory
  36   (expand-file-name "sounds"
  37                     (file-name-directory
  38                      (or load-file-name buffer-file-name)))
  39   "The directory where chess sounds can be found."
  40   :type 'directory
  41   :group 'chess-sound)
  42
  43 (defcustom chess-sound-play-function (if (fboundp 'play-sound-file)
  44                                          'play-sound-file
  45                                        'chess-sound-play)
  46   "Non-nil if chess-sound should play sounds ."
  47   :type 'function
  48   :group 'chess-sound)
  49
  50 (defcustom chess-sound-program (or (executable-find "esdplay")
  51                                    (executable-find "play"))
  52   "Program used to play sounds, if `play-sound-file' does not exist."
  53   :type 'file
  54   :group 'chess-sound)
  55
  56 (defcustom chess-sound-args nil
  57   "Additional args to pass to `chess-sound-program', before the .WAV file."
  58   :type '(repeat string)
  59   :group 'chess-sound)
  60
  61 (defcustom chess-sound-my-moves nil
  62   "If non-nil, plays the move.wav sound whenever you make a move."
  63   :type 'boolean
  64   :group 'chess-sound)
  65
  66 (defsubst chess-sound (file)
  67   (ignore-errors
  68     (funcall chess-sound-play-function
  69              (expand-file-name (concat file ".wav")
  70                                chess-sound-directory))))
  71
  72 (defsubst chess-sound-play (file)
  73   (apply 'call-process chess-sound-program
  74          nil nil nil (append chess-sound-args (list file))))
  75
  76 (defun chess-sound-handler (game event &rest _args)
  77   (cond
  78    ((eq event 'initialize)
  79     (and (file-directory-p chess-sound-directory)
  80          (file-readable-p (expand-file-name "move.wav"
  81                                             chess-sound-directory))
  82          (or (eq chess-sound-play-function 'play-sound-file)
  83              (and chess-sound-program
  84                   (file-executable-p chess-sound-program)))))
  85
  86    ((eq event 'move)
  87     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
  88            (pos (chess-ply-pos ply)))
  89       (if (eq (chess-game-data game 'my-color)
  90               (chess-pos-side-to-move pos))
  91           (if chess-sound-my-moves
  92               (chess-sound "move"))
  93         (let* ((source (chess-ply-source ply))
  94                (target (chess-ply-target ply))
  95                (s-piece (and source (chess-pos-piece pos source)))
  96                (t-piece (and target (chess-pos-piece pos target)))
  97                (which (chess-ply-keyword ply :which)))
  98           (cond
  99            ((chess-ply-keyword ply :castle)
 100             (chess-sound "O-O"))
 101            ((chess-ply-keyword ply :long-castle)
 102             (chess-sound "O-O-O"))
 103            ((and s-piece t-piece (= t-piece ? ) target)
 104             (if which
 105                 (chess-sound (char-to-string which)))
 106             (chess-sound (format "%c_" (downcase s-piece)))
 107             (chess-sound (chess-index-to-coord target)))
 108            ((and s-piece t-piece target)
 109             (if which
 110                 (chess-sound (char-to-string which)))
 111             (chess-sound (format "%c_" (downcase s-piece)))
 112             (chess-sound "x_")
 113             (chess-sound (format "%c_" (downcase t-piece)))
 114             (chess-sound (chess-index-to-coord target))))
 115
 116           (if (chess-ply-keyword ply :promote)
 117               (chess-sound
 118                (format "%c_" (downcase
 119                               (chess-ply-keyword ply :promote)))))
 120           (if (chess-ply-keyword ply :en-passant)
 121               (chess-sound "enpassant"))
 122           (if (chess-ply-keyword ply :check)
 123               (chess-sound "+_"))
 124           (if (chess-ply-keyword ply :checkmate)
 125               (chess-sound "#_"))
 126           (if (chess-ply-keyword ply :stalemate)
 127               (chess-sound "smate"))))))))
 128
 129 (provide 'chess-sound)
 130
 131 ;;; chess-sound.el ends here