Try to improve the promotion situation on ICS by allowing chess-ply to query for...

[gnu-emacs-elpa] / chess-sound.el

diff --git a/chess-sound.el b/chess-sound.el
index 666be6c0d2b42398555f81244305d1537898d51d..ed1ce532d5e51984c5fb988b74305ea5022a3e69 100644 (file)
--- a/chess-sound.el
+++ b/chess-sound.el
@@ -3,7 +3,6 @@
 ;; This is very similar to chess-announce, except it uses specific
 ;; .WAV files instead of text-to-speech.
 ;;
-;; $Revision$
 
 (require 'chess-game)
 
@@ -23,7 +22,7 @@
                                         'play-sound-file
                                       'chess-sound-play)
   "Non-nil if chess-sound should play sounds ."
-  :type 'file
+  :type 'function
   :group 'chess-sound)
 
 (defcustom chess-sound-program (or (executable-find "esdplay")
@@ -37,67 +36,74 @@
   :type '(repeat string)
   :group 'chess-sound)
 
-(defun chess-sound-available-p ()
-  (and (file-directory-p chess-sound-directory)
-       (file-readable-p (expand-file-name "tap.wav"
-                                         chess-sound-directory))
-       (or (eq chess-sound-play-function 'play-sound-file)
-          (file-executable-p chess-sound-program))))
-
-(defun chess-sound-for-game (game)
-  "Announce the opponent's moves in GAME."
-  (chess-game-add-hook game 'chess-sound-event-handler))
+(defcustom chess-sound-my-moves nil
+  "If non-nil, plays the move.wav sound whenever you make a move."
+  :type 'boolean
+  :group 'chess-sound)
 
-(defun chess-sound (ch)
-  (let ((file
-        (cond
-         ((stringp ch)
-          (format "%s.wav" ch))
-         ((memq ch '(?\# ?\+ ?k ?q ?b ?n ?r ?p ?x))
-          (format "%c_.wav" ch))
-         (t
-          (format "%s.wav" (chess-index-to-coord ch))))))
+(defsubst chess-sound (file)
+  (ignore-errors
     (funcall chess-sound-play-function
-            (expand-file-name file chess-sound-directory))))
+            (expand-file-name (concat file ".wav")
+                              chess-sound-directory))))
 
-(defun chess-sound-play (file)
-  (apply 'call-process chess-sound-program nil nil nil chess-sound-args))
+(defsubst chess-sound-play (file)
+  (apply 'call-process chess-sound-program
+        nil nil nil (append chess-sound-args (list file))))
 
-(defun chess-sound-event-handler (game ignore event &rest args)
-  "This display module presents a standard chessboard.
-See `chess-display-type' for the different kinds of displays."
+(defun chess-sound-handler (game event &rest args)
   (cond
+   ((eq event 'initialize)
+    (and (file-directory-p chess-sound-directory)
+        (file-readable-p (expand-file-name "move.wav"
+                                           chess-sound-directory))
+        (or (eq chess-sound-play-function 'play-sound-file)
+            (and chess-sound-program
+                 (file-executable-p chess-sound-program)))))
+
    ((eq event 'move)
     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
           (pos (chess-ply-pos ply)))
       (if (eq (chess-game-data game 'my-color)
              (chess-pos-side-to-move pos))
-         (chess-sound "tap")
+         (if chess-sound-my-moves
+             (chess-sound "move"))
        (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))
+              (s-piece (and source (chess-pos-piece pos source)))
+              (t-piece (and target (chess-pos-piece pos target)))
+              (which (chess-ply-keyword ply :which))
               text)
          (cond
-          ((chess-ply-has-keyword :castle)
+          ((chess-ply-keyword ply :castle)
            (chess-sound "O-O"))
-          ((chess-ply-has-keyword :long-castle)
+          ((chess-ply-keyword ply :long-castle)
            (chess-sound "O-O-O"))
-          ((= t-piece ? )
-           (chess-sound (downcase s-piece))
-           (chess-sound target))
-          (t
-           (chess-sound (downcase s-piece))
-           (chess-sound ?x)
-           (chess-sound (downcase t-piece))
-           (chess-sound target)))
-         (if (chess-ply-has-keyword :check)
-             (chess-sound ?+))
-         (if (chess-ply-has-keyword :checkmate)
-             (chess-sound ?#))
-         (if (chess-ply-has-keyword :stalemate)
-             (chess-sound "smate")))))
-    nil)))
+          ((and s-piece t-piece (= t-piece ? ) target)
+           (if which
+               (chess-sound (char-to-string which)))
+           (chess-sound (format "%c_" (downcase s-piece)))
+           (chess-sound (chess-index-to-coord target)))
+          ((and s-piece t-piece target)
+           (if which
+               (chess-sound (char-to-string which)))
+           (chess-sound (format "%c_" (downcase s-piece)))
+           (chess-sound "x_")
+           (chess-sound (format "%c_" (downcase t-piece)))
+           (chess-sound (chess-index-to-coord target))))
+
+         (if (chess-ply-keyword ply :promote)
+             (chess-sound
+              (format "%c_" (downcase
+                             (chess-ply-keyword ply :promote)))))
+         (if (chess-ply-keyword ply :en-passant)
+             (chess-sound "enpassant"))
+         (if (chess-ply-keyword ply :check)
+             (chess-sound "+_"))
+         (if (chess-ply-keyword ply :checkmate)
+             (chess-sound "#_"))
+         (if (chess-ply-keyword ply :stalemate)
+             (chess-sound "smate"))))))))
 
 (provide 'chess-sound)